Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / tsnker.alp < prev next >

Wrap

Text File | 1988-08-16 | 230.0 KB | 8,104 lines

KERMIT: TITLE 'NIH TSO KERMIT'; SUBTITLE 'MACRO DEFINITIONS'; MACRO &&L: CHAR &® % MAKES INTEGER PRINTABLE &&L: AI &®,32; MEND; MACRO &&L: BCCTYPE &&LIT; % SETS BLOCK CHECK TYPE &&L: MVI LEVELCK,&&LIT; % BCC LEVEL CHECKING MVI BCCLEN+1,&&LIT; MEND; MACRO &&L: BUMPSEQ &® % INCREMENTS SEQUENCE NUMBER &&L: LH &®,SEQNUM; % GET PREVIOUS SEQ NUMBER STH &®,OLDSEQ; AI &®,1; % INCREMENT IT N &®,MOD64; % GET MOD 64 STH &®,SEQNUM; MEND; % SPSPACK - PASS PARAMETERS TO SPACK MACRO &&L: SPSPACK &&PTYPE,&&PNUM,&&SDATALEN,&® % n &&L: MVI PTYPE,&&PTYPE; % PACKET TYPE LH &®,&&PNUM; CHAR &® % MAKE IT A CHARACTER STC &®,PNUM; MMVC PUTLEN,&&SDATALEN,2; % DATA LEN OF SEND PACK MEND; MACRO &&L: RPSPACK &&SMARK,&&PTYPE,&&PNUM,&&SDATALEN,&&PTRDATA; % n &&L: MMVC &&SMARK,SSOH; % SOH PACKET FOR PACKET MEND; MACRO &&L: BUMPRTRY &® % INCREMENT RETRY &&L: L &®,NUMTRY; % GET RETRY COUNT AI &®,1; % INCREMENT BY 1 ST &®,NUMTRY; MEND; MACRO &&L: BUMPOTRY &® % INCREMENT RETRY &&L: L &®,OLDTRY; % GET RETRY COUNT AI &®,1; % INCREMENT BY 1 ST &®,OLDTRY; MEND; MACRO &&L: ZEROSEQ; % ZERO OUT RETRY &&L: MVI OLDSEQ,0; MVI OLDSEQ,63; % FORMER NUMBER MZC SEQNUM,L'SEQNUM; % GET RETRY COUNT MEND; MACRO &&L: ZERORTRY; % ZERO OUT RETRY &&L: MMVC OLDTRY,NUMTRY,4; MZC NUMTRY,L'NUMTRY; % GET RETRY COUNT MEND; MACRO &&L: ZEROSDAT; % ZERO OUT LENGTH OF DATA TO PUT &&L: MZC PUTLEN,2; % ZERO LENGTH OF DATA TO PUT MEND; MACRO &&L: LENCALC &®1; &&L: LH &®1,BCCLEN; % LEN OF BCC AH &®1,PUTLEN; AI &®1,YLEN; % HEADER LENGTH MEND; MACRO &&L: MAKESLEN &&LIT,&®1; &&L: LI &®1,&&LIT; % GET THE LITERAL STH &®1,PUTLEN; MEND; MACRO &&L: UNCHAR &® % TRANSFORMS PRINTABLE TO INTEGER &&L: SI &®,32; MEND; MACRO &&L: PACKTYPE &&LIT; % MOVES PACKET TYPE USED BY SPACK &&L: MVI TYPE,&&LIT; MEND; MACRO &&L: CNTLLOC &&STORAGE; % MAKES CNTL CHAR PRINT &&L: XI &&STORAGE,X'40'; MEND; MACRO &&L: MOVEALL; % MOVE ALL DATA &&L: LR VR0,VR1; SR VR0,XRB; % LENGTH LR VR1,XRB; % SET UP POINTER FOR SUB CCALL PUTEM,A; % SUB PUTS IN AR VR1,VR0; % VR1-> BACK WHERE WAS %LH XRB,RDATALEN; %SR XRB,VR0; %STH XRB,RDATALEN; % UPDATE GET LENGTH DECREGDD XRB,VR0; % DECREMENT COUNTER MEND; MACRO &&L: ACKIT &® % ACKNOWLEDGE PACKET &&L: MMVC PNUM,RSEQ,1; % MOVE SEQUENCE NUMBER ADCONLEN &®,YLEN,PLEN; % COMPUTE LENGTH MVI PTYPE,YCOMLIT; % YACK TYPE CCALL SPACK,A; ZR &® IC &®,RSEQ; % GET SEQUENCE NUMBER UNCHAR &® % MAKE INTEGER STH &®,RECSEQ; % STORE OFF COUNTER MEND; MACRO &&L: NACKIT &® % NEGATIVE ACKNOWLEDGE PACKET &&L: MMVC PHDR,SSOH; % PUT IN START OF HEADER MMVC PNUM,RSEQ,1; % MOVE SEQUENCE NUMBER ADCONLEN &®,NLEN,PLEN; % COMPUTE LENGTH MVI PTYPE,NCOMLIT; % NACK TYPE CCALL SPACK,A; MEND; MACRO &&L: NACKPACK &&SEQ,&® % NEGATIVE ACKNOWLEDGE PACKET &&L: SPSPACK AN,&&SEQ,ZERO,&® % N PACKET,SEND PARAMETERS FOR SPACK CCALL SPACK,A; MEND; MACRO &&L: SERVNACK &® % NEGATIVE ACKNOWLEDGE PACKET &&L: MMVC PHDR,SSOH; % PUT IN START OF HEADER MVI PNUM,X'20'; % MOVE SERVER 0 NUMBER ADCONLEN &®,NLEN,PLEN; % COMPUTE LENGTH MVI PTYPE,NCOMLIT; % NACK TYPE CCALL SPACK,A; MEND; MACRO &&L: ACKPACK &&SEQ,&® % POSTIVE ACKNOWLEDGE PACKET &&L: SPSPACK AY,&&SEQ,ZERO,&® % N PACKET,SEND PARAMETERS FOR SPACK CCALL SPACK,A; MEND; MACRO &&L: ZAP8BIT &&STORAGE; % MAKES CNTL CHAR PRINT &&L: NI &&STORAGE,X'7F'; MEND; MACRO &&L: CNTLREG &® &&L: X &®,O1H; % XOR '64' MEND; MACRO &&L: ADCONLEN &®1,&&LITEQU,&&PACLEN; &&L: LI &®1,&&LITEQU; % CHAR &®1; % MAKE IT ALPHA INTEGER MMVC PUTLEN,=X'0000',2; STC &®1,&&PACLEN; MEND; MACRO &&L: DECRDATA &®1,&&LIT; &&L: % THIS MACRO DECREMENT RDATALEN + UPDATES RDATAADD LH &®1,RDATALEN; SI &®1,&&LIT; STH &®1,RDATALEN; L &®1,RDATAADD; AI &®1,&&LIT; ST &®1,RDATAADD; MEND; MACRO &&L: DECREGDD &®1,&®2; &&L: %THIS MACRO DECREMENT RDATALEN UPDATES RDATAADD USING REGISTERS L &®1,RDATAADD; AR &®1,&®2; ST &®1,RDATAADD; LH &®1,RDATALEN; SR &®1,&®2; STH &®1,RDATALEN; MEND; BAL; % FOR MACRO DEFINITIONS MACRO &LAB WRTERM &MSG LCLC &MS LCLA &LN &MS SETC '&MSG' &LN SETA K'&MS &LN SETA &LN-2 &LAB TPUT =C&MS,&LN MEND MACRO &LAB ERRORCON &MSG LCLC &MS LCLA &LN &MS SETC '&MSG' &LN SETA K'&MS &LN SETA &LN-2 &LAB LA 1,=C&MS LA 0,&LN MEND MACRO &LAB PROMPT &MSG LCLC &MS LCLA &LN &MS SETC '&MSG' &LN SETA K'&MS &LN SETA &LN-2 &LAB TPUT =C&MS,&LN,ASIS MEND MACRO RDTERM &BUFF TGET &BUFF,130 MEND ALP; SUBTITLE 'DEFINITIONS'; COPY CPARMGBL; % COPY GLOBAL SYMBOLS KERMIT: CSETUP MDC=YES,S99=YES; SPLEVEL SET=1; % INSURE MVS/370 MACRO EXPANSIONS EJECT; WA: AREA; BEGIN CSA VRE,HIGHR,EQU=(WAVRF,VRF); WASIZE: AREAEND; END; EJECT; IKJCPPL; IKJLSD; IKJGTPB; IKJUPT; IKJPSCB; IKJTAIE; KERMIT: CSECT; EJECT; AD: EQU 68; % DATA PACKET (ASCII 'D') AN: EQU 78; % NAK AZ: EQU 90; % EOF PACKET AS: EQU 83; % INIT PACKET AY: EQU 89; % ACK AF: EQU 70; % FILE PACKET AB: EQU 66; % BREAK PACKET AE: EQU 69; % ERROR PACKET AX: EQU 88; ERCOD: EQU 12; % MEANS EOF WITH 'FSREAD' FLG1: EQU X'80'; % IS FILE THE FIRST OR NOT FLG2: EQU X'40'; % OVERWRITE SENT FILENAME? FLG3: EQU X'20'; % ONE = SENT ONLY PARTIAL RECORD FLG4: EQU X'10'; % NAK FROM MICRO(0) OR RPACK(1)? FLG5: EQU X'08'; % ALLOCATED MORE SPACE (DMSFREE) FLGBIN: EQU X'04'; % BINARY FILE TRANSFER BIT8ON: EQU X'80'; % MASK FOR CHECKING AND TURNING BIT8OFF: EQU X'7F'; % BITS ON OR OFF !! QUOTEYES: EQU X'01'; % SWITCH FOR EIGHT BIT QUOTING FILEWRIT: EQU X'80'; % FILE WRITE OCCURRED ? SUBTITLE 'KERMCNTL'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % MODULE NAME - KERMCNTL % % % FUNCTION- THE DRIVER MODULE FOR KERMIT TSO % % % % INPUTS - NONE % % % % % OUTPUTS- KERMIT PROCESSING COMPLETED % % % RETURN % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% OSENTER (14,12),SAVE=SAVECNTL,FORWARD=YES; L XRF,PARMSADD; LA XRG,4095(,XRF); % SET UP STORAGE BASE REGS USING PARMS,XRF; USING PARMS+4095,XRG; ST STKR,OSAVE; % NEW STACK POINTER LA STKR,STACK; % INTERNAL STACK ST VR1,CPPLADD; % ADDRESS OF COMMAND PROCESSOR PARAMETER LIST USE VR1 AS CPPL IN BEGIN L XRA,CPPLUPT; % FOR PUT GET STUFF ST XRA,UPTADD; L XRA,CPPLECT; ST XRA,ECTADD; MMVC CBUFFADD,CPPLCBUF,4; % ADDRESS TO COMMAND END; % OF CPPL BLOCK L VR1,CPPLADD; % ADDRESS OF COMMAND PROCESSOR PARMETER LIST L VR0,UPTADD; % ADDRESS OF UPT CALL USERID; % EXTERNAL ROUTINE RETURNS ADDRESS AND LENGTH % OF USER PREFIX IN VR1 & VR0 RESPECTIVELY IF <CI VR0,44; CC H> THEN BEGIN % REAL PROBLEMS CAN NOT GET USER ID WRTERM 'Length of user prefix greater than 44.'_ ' Check USERID external routine.'; WRTERM 'Must terminate'; GOTO DOEXIT; END; ST VR1,USERPREA; % STORE OFF PREFIX ADDRESS STH VR0,USERPREL; % LENGTH OF PREFIX L XRD,STAXOLD; % SAVE THE REPLACE L XRB,STAXADD; % PARMETER EXIT ROUTINE ADDRESS L XRC,STAXLADD; % PARM LIST ADDRESS STAX (XRB),DEFER=NO,REPLACE=YES,MF=(E,(XRD)); STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); LOAD EP=TSOLNK; ST VR0,TSOADD; % STORE OFF ADDRESS L XRB,TGETADD; % ADDRESS OF TGET MODULE IDENTIFY EP=KERMTGET,ENTRY=(XRB); IF <RNZ VRF> THEN BEGIN % ERROR IN IDENTIFY TPUT =C'ERROR IN IDENTIFY',17; END; LOAD EP=IKJGETL; % GET LINE ROUTINE ADDRESS ST VR0,GETLINAD; % STORE IT OFF ATTACH EP=KERMTGET,PARAM=((XRF)); IF <RNZ VRF> THEN BEGIN TPUT =C'ERROR IN ATTACH ',16; END; ST VR1,TASKADD; % STORE OFF ADDRESS FOR DETACH LOAD EP=IKJSTCK; % STACK ROUTINE ST VR0,STACKADD; % STORE OFF POINTER TO STACK ROUTINE CCALL STCKMOD,A; % STACK ROUTINE TO CHECK FOR PARAMETER ON ENTRY CALL EDINIT,(EDCNTRL,EDRETURN); % INITIALIZATION FOR ED ROUTINES CCALL KRESET,A; % INITALIZATION SUB CCALL PROFILES,A; % EXECUTES SYSTEM AND USER PROFILES %WRTERM ' '; % BLANK LINE WRTERM 'NIH TSO KERMIT VERSION 1.1A'; % VERSION LOGON %WRTERM ' '; % BLANK LINE MAINLOOP: FOREVER DO BEGIN % MAIN LOOP DO BEGIN % LOOP IF NO INPUT %PROMPT: ; % MAIN PROMPT FOR PROGRAM ZF STOPF; % ZERO STOP FLAG INCASE IT WAS SET IF <TF SENDDSNF> THEN CALL EDCLOS,(EDCNTRL,EDRETURN); % CLOSE INPUT IF <TF RECVDSNF> THEN CALL EDCLOS,(EDCNTRL,EDRETURN); %CLOSE OUTPUT % PROMPT 'KERMIT-TSO> '; % MAIN PROMPT FOR PROGRAM % RDTERM INPUT; % GET INPUT FROM USER CCALL PROMPTIT,A; LH VR1,INPUT; % SET UP FOR DEBLANK SI VR1,4; % SUBTRACT OFF HEADER END UNTIL <RNZ VR1>; % IF NO INPUT REPROMPT SCINIT INPUT+4,(VR1); % SET UP SCANNER SCTYPE NEW=1; SCERROR NEW=PARSEERR; SCANBLCK: DO BEGIN SCAN *; % SCAN OFF FUNCTIONS SCKW (RECEIVE,REC,R),DOREC; % RECEIVE COMMAND SCKW (SEND,S),DOSEND; % SEND COMMAND - 44 CHAR SCKW SHOW,DOSHOW; % SHOW COMMAND SCKW (ST,STATUS),DOSTATUS; % STATUS COMMAND SCKW EXIT,DOQUIT; % EXIT COMMAND - SCKW END,DOQUIT; % END ALSO QUIT COMMAND - SCKW QUIT,DOQUIT; % QUIT COMMAND - SCKW SERVER,DOSERVER; % SERVER COMMAND - SCKW ?,DOQUES; % QUESTION COMMAND - SCKW HELP,DOHELP; % HELP COMMAND - SCKW RESET,DORESET; % RESET COMMAND - SCKW SET,DOSET; % SET COMMAND - SCKW TSO,DOTSO; % TSO COMMAND - SCKW TEST,DOTEST; % SCKW EXECUTE,DOEXEC; % EXEC COMMAND - SCKW (KERMIT,K),DOKERM; % FOR EXEC COMMANDS TO CRUCOMVENT TSO SCKW STOP,STOPHELP; % COMMAND ONLY USED TO STOP TRANSFER SCKW ,INVALKEY; % UNKNOWN COMMAND - SCANEND; PARSEERR: WRTERM 'Unknown TSO KERMIT command'; NEXT OF MAINLOOP; DOREC: <CCALL KRECEIVE,A>; % WE HAVE A RECEIVE COM NEXT OF MAINLOOP; DOSEND: <CCALL KSEND,A>; % WE HAVE A SEND COMMAND NEXT OF MAINLOOP; DOSHOW: <CCALL KSHOW,A>; % WE HAVE A SHOW COMMAND NEXT OF MAINLOOP; DOSTATUS: SCTELL; IF <RP VR0> THEN BEGIN WRTERM 'STATUS displays messages that tell what happened during the'; WRTERM 'last file transfer operation.'; END ELSE <CCALL KSTATUS,A>; % WE HAVE A STATUS COMMAND NEXT OF MAINLOOP; DOTEST: %IF YOUR SYSTEM PROGRAMMER THEN BEGIN SF TESTF; SCAN; %SCANEND; IF <MCLC 0(VR1),=C'OFF',3> THEN BEGIN ZF TESTF; CLOSE TESTFILE; END ELSE BEGIN DATA BEGIN TESTX: DC C'ALLOC FI(TESTFILE) DS(KERMIT.TESTFILE)' END; TESTXLEN: EQU *-TESTX; LI VR0,TESTXLEN; %CCALL TSOCMD,A,VR1=TESTX; OPEN (TESTFILE,(INPUT)); IF ^<OPENP TESTFILE> THEN BEGIN WRTERM 'UNABLE TO OPENTEST FILE'; END; END; % END; NEXT OF MAINLOOP; DORESET: SCAN *; SCKW ?,RESETHLP; SCKW HELP,RESETHLP; SCANEND; <CCALL KRESET,A>; % WE HAVE A RESET COMMAND NEXT OF MAINLOOP; DOKERM: SCAN *; SCKW ?,KERHELP; SCKW ,*,B; % PAST ON THROUGH SCANEND; NEXT OF SCANBLCK; KERHELP : WRTERM 'The KERMIT command allows TSO KERMIT to process TSO KERMIT'; WRTERM 'SET comands from an EXEC (CLIST) data set.'; WRTERM 'Any TSO KERMIT SET command '_ 'in an EXEC data set must be prefixed by KERMIT.'; NEXT OF MAINLOOP; RESETHLP: WRTERM 'RESET resets TSO KERMIT options to initial defaults.'; NEXT OF MAINLOOP; DOHELP: SCTELL; IF <RP VR0> THEN BEGIN WRTERM 'HELP tells how to use the TSO KERMIT help facility to get'; WRTERM 'information about TSO KERMIT commands.'; END ELSE BEGIN % WE HAVE A HELP COMMAND WRTERM 'Enter ? at prompt to receive list of commands.'; WRTERM 'Enter ? after a command to receive list of operands.'; END; % OF HELP NEXT OF MAINLOOP; DOQUES: BEGIN % WE HAVE A ? COMMAND CCALL MAINHELP,A; % HELP ROUTINE NEXT OF MAINLOOP; END; % OF QUESTION BLOCK DOSET: <CCALL KSET,A>; % WE HAVE A SET COMMAND NEXT OF MAINLOOP; STOPHELP: WRTERM 'STOP is used to abort a file transfer currently in progress.'; NEXT OF MAINLOOP; DOEXEC: % EXEC A FILE FULL OF KERMIT COMMANDS IF <CI VR0,7> THEN <MMVC 4(VR1),=C' ',3>; SCBACK; % BACK UP TO INCLUDE COMMAND SCTELL; % GET REMAINDER ST VR1,TSOCMDA; STH VR0,TSOCMDL; SCAN; DO BEGIN SCAN *; % CHECK FOR HELP REQUEST SCKW ?,EXECHELP; SCKW ,SENDEXEC; SCANEND; END; WRTERM 'EXECUTE command requires a data set name of TSO KERMIT'_ ' commands.'; NEXT OF MAINLOOP; EXECHELP: WRTERM 'The EXECUTE command processes a data set containing TSO '_ 'KERMIT commands. The only parameter is the'; WRTERM 'name of the data set.'; NEXT OF MAINLOOP; SENDEXEC: CCALL TSOCMD,A,VR1=L:TSOCMDA,VR0=LH:TSOCMDL; % LET TSO FEED NEXT OF MAINLOOP; DOTSO: SCTELL; DEBLANK VR1,VR0,XRA; % DEBLANK STRING IF <RNP VR0> THEN BEGIN % NO PARMS % NO MESSAGE WRTERM 'TSO Command requires a command string '; NEXT OF MAINLOOP; END ELSE BEGIN UNTIL ^<CLI 0(VR1),C' '> DO BEGIN SI VR0,1; % DECREMENT COUNTER AI VR1,1; END; IF <CI VR0,1> & <CLI 0(VR1),C'?'> THEN BEGIN TSOHELP: WRTERM _ 'The TSO command is followed (on the same line) by a TSO command'_ ' to be executed.'; NEXT OF MAINLOOP; END ELSE BEGIN TSOKEY: CCALL TSOCMD,A; % WE HAVE A TSO COMMAND END; END; NEXT OF MAINLOOP; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DOQUIT: DO BEGIN SCAN *; SCKW (HELP,?),EXITHELP; SCKW ,BADEXIT; SCANEND; GOTO DOEXIT; % REALLY WANT TO LEAVE EXITHELP: WRTERM 'END, EXIT, and QUIT terminate TSO KERMIT '_ 'and return the user to TSO.'; NEXT OF MAINLOOP; BADEXIT: WRTERM 'No parameters except HELP for QUIT or END '; NEXT OF MAINLOOP; END; % OF QUIT BLOCK DOSERVER: DO BEGIN SCAN *; SCKW (HELP,?),SERVHELP; SCKW ,BADSERV; SCANEND; SF SERVERF; % TURN ON SERVER INDICATOR CCALL SERVER,A; % ENGAGE SERVER SLAVE MODE ZF SERVERF; % TURN OFF SERVER INDICATOR GOTO DOEXIT IF <TF LOGOUT>; % IF LOGPOFF GET OUT NEXT OF MAINLOOP; SERVHELP: WRTERM 'The SERVER command invokes TSO KERMIT '_ 'as a slave server of the microcomputer.'; WRTERM 'While TSO KERMIT is in server mode, all commands are'_ ' normally'; WRTERM 'issued to the microcomputer only. However, '_ 'TSO KERMIT will recognize'; WRTERM '"FINISH" as a command to leave server mode.'; NEXT OF MAINLOOP; BADSERV: WRTERM 'No parameters except ? for SERVER'; NEXT OF MAINLOOP; END; % OF SERV BLOCK % INVALID COMMAND %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % INVALKEY: WRTERM 'Invalid TSO KERMIT Command.'_ ' Type in HELP if you need assistance.'; END; % OF SCANBLCK END; % OF FOREVER MAIN DO LOOP DOEXIT: IF <TF SENDDSNF> THEN CALL EDCLOS,(EDCNTRL,EDRETURN); % CLOSE INPUT IF <TF RECVDSNF> THEN CALL EDCLOS,(EDCNTRL,EDRETURN); %CLOSE OUTPUT IF <OPENP DEBUG> THEN CLOSE DEBUG; % CLOSE FILES CALL EDTERM,(EDCNTRL,EDRETURN); % TERMINATE ED ROUTINE PROCESSING DETACH TASKADD; % RELEASE AYSN TGET READ ROUTINE FREEMAIN RC,SP=18; % FREE TAB BUFFER L STKR,OSAVE; % RESTORE STACK POINTER ZR VRF; % OK PROCESSING FOR CP OSEXIT (14,14),(0,12),SAVE=SAVECNTL; SAVECNTL: DC 18F'0'; % SAVE AREA USE VRF AS STAXEXIT IN BEGIN STAXEXIT: DS 0H; % THE STAX EXIT HERE DO NOTHING BUT KEEP GOING BR ON 14 RGOTO 14; % GO REG 14 % END; % OF USING PARMSADD: DC A(PARMS); % ADDRESS OF STORAGE LTORG; STAXLIST: STAX 0,DEFER=NO,REPLACE=NO,MF=L; STAXOLDL: STAX 0,DEFER=NO,REPLACE=YES,MF=L; EXORG; SUBTITLE 'MAINHELP'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %MOD: MAINHELP % FUNCTION: PRINTS HELPS FOR DRIVER LOOP % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MAINHELP: CENTER VRE,HIGHR,ENTRY=NO; WRTERM 'Legal commands are: '; WRTERM ' '; WRTERM 'RECEIVE uploads a data set (file) from the micro'_ 'computer to the mainframe'; WRTERM 'SEND downloads a data set (file) from the mainframe '_ 'to the microcomputer'; WRTERM 'STOP aborts a file transfer in progress '_ '(valid only during file transfer)'; WRTERM 'STATUS displays the status of the last file transfer'; WRTERM 'SERVER invokes TSO KERMIT as a slave server'; WRTERM 'END terminates TSO KERMIT and returns user to TSO '; WRTERM 'QUIT and EXIT are synonyms of END'; WRTERM 'SET changes KERMIT protocol and data set options '; WRTERM 'SHOW displays the current KERMIT option settings '; WRTERM 'RESET reinitializes KERMIT to default settings '; WRTERM 'HELP tells how to use the TSO KERMIT help facility'; WRTERM 'TSO issues a command to TSO'; WRTERM 'EXEC reads a data set of TSO KERMIT commands '_ '(a TSO CLIST)'; WRTERM 'KERMIT allows TSO KERMIT EXEC files to process the '_ 'TSO KERMIT SET commands'; WRTERM '(must prefix each SET cmd)'; WRTERM ' '; % BLANK LINE WRTERM 'TSO KERMIT executes a profile containing TSO KERMIT'_ ' commands at program startup. '; WRTERM 'KERMIT.PROFILE.CLIST is the profile data set name.'; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'PROMPTIT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: PROMPIT % FUNCTION: DO A PUT GET FOR INPUT AT THE TERMINAT % INPUT : NONE % OUTPUT: INFO MOVED INTO INPUT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PROMPTIT: CENTER VRE,HIGHR,ENTRY=NO; L XRA,UPTADD; L XRB,ECTADD; DO BEGIN L 15,GETLINAD; % ENTRY POINT FOR GETLINE ROUTINES GETLINE PARM=APGPB,UPT=(XRA),ECT=(XRB),ECB=ECBGETLN,_ TERMGET=(EDIT,NOWAIT),ENTRY=(15),_ MF=(E,IOPLADS); PROMPCAS: CASE VRF MAX 36 MIN 0 CHECK; 0: BEGIN % LINE FROM TERMINAL %PROMPT 'KERMIT-TSO> '; % MAIN PROMPT FOR PROGRAM ZR VRF; % ZERO RETURN AFTER TPUT END; % JUST FALL OUT 4: BEGIN % INPUT FROM STACK - CLIST ETC % JUST FALL OUT DON'T ISSUE PROMPT; END; 8: ; % EOD JUST FALL THROUGH 12: BEGIN % NO INPUT ISSUE PROMPT AND WAIT PROMPT 'KERMIT-TSO> '; % MAIN PROMPT FOR PROGRAM L 15,GETLINAD; % ENTRY POINT FOR GETLINE ROUTINES GETLINE PARM=APGPB,UPT=(XRA),ECT=(XRB),ECB=ECBGETLN,_ TERMGET=(EDIT,WAIT),_ ENTRY=(15),MF=(E,IOPLADS); NEXT OF PROMPCAS; END; 16 THRU 36: ; % FALL THROUGH ENDCASE ELSE WRTERM 'UNKNOWN VALUE RETURNED FROM GETLINE'; END UNTIL <CI VRF,0> | <CI VRF,4>; DATA BEGIN APGPB: GETLINE MF=L; END; LA XRA,APGPB; USE XRA AS GTPB IN L VR1,GTPBIBUF; LH XRB,0(VR1); % LENGTH OF STUFF EXI XRB,MMVC,INPUT,(VR1),0,INCR=YES,DECR=YES; %O XRB,=X'01000000'; % OR LENGTH PER GTWTMP MANUAL PAGE 12-79 FREEMAIN RC,LV=(XRB),A=(VR1),SP=1; % FREE UP THE INPUT BUFFER SI XRB,4 ; % REMOVE LENGTH EXI XRB,MTR,INPUT+4,UPPER,*-*,INCR=YES,DECR=YES ; % UPPER CASE CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'KERMIT WORKING STORAGE'; PARMS: DS 0H; % GLOBAL DATA LIST; TESTFILE: DCB DDNAME=TESTFILE,DSORG=PS,MACRF=(GL),_ EODAD=KLUDGCIT,LRECL=264,RECFM=VB,BLKSIZE=2048; TESTEOF: DC A(KLUDGCIT); % IN RPACK ROUTINE %KEROUT: DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84,_ % RECFM=VB; DEBUG: DCB DDNAME=DEBUG,DSORG=PS,MACRF=(PM),LRECL=260,BLKSIZE=2048,_ RECFM=VB; %MODDCBF: DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=80,_ % RECFM=FB; %MODDCBFL: EQU *-MODDCBF; %MODDCBV: DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84,_ % RECFM=VB; %MODDCBVL: EQU *-MODDCBV; DF SAMEPKTF,RECFLAG,SENDFLAG,SHOWFLAG,DATAFLAG,_ % DEFINE FLAGS STOPF,STURNRND,RTURNRND; DF QUITFLAG,HELPFLAG,SETFLAG,EXITFLAG,QUESFLAG,_% DEFINE FLAGS PREFPDSF,ACKX,ACKZ; % FOR ACK WITH X DATA OR Z DATA DF DBUGFLAG,TESTF,BIT8FLAG,CRFLAG,QUOFLAG,QUO8FLAG,KINEOF,_ LOGOUT; DF SENDDSNF,RECVDSNF,EDITF,TABF,TABFOUND,FORWARDF,HIGHBITF,REPTF; DF FORWARD,SERVERF,TIMERF,WARNINGF,PDSF,ASTERISK,_ FULLQUOF,PREFXQUO; % MORE FLAGS DF WARNTPCK,FULLQDSN ; STAXADD: DC A(STAXEXIT); % ADDRESS OF STAX ROUTINE STAXLADD: DC A(STAXLIST); % ADDRESS OF STAX PARM LIST STAXOLD: DC A(STAXOLDL); UPTADD: DS A; % ADDRESS OF UPT FROM CPPL STACKADD: DS A; % ADDRESS OF STACK MODULE CBUFFADD: DS A; % ADDRESS OF CPPLCBUFF ON LOG IN ECTADD: DS A; % ADDRESS OF ECT FROM CPPL ECBGETLN: DC F'0'; % PUT GET ECB OLD: DC F'1'; % OUT PUT LINE DESCRIPTOR ONLY ONE ON CHAIN % DC F'1'; % NUMBER OF MESSAGE SEGMENTS ONLY ONE DC A(PROMPT); % MESSAGE TO PUT OUT PROMPT: DC H'17'; % LENGTH OF MESSAGE DC H'0'; % FOR PROMPT DC C' KERMIT-TSO> '; % THE PROMPT MESSAGE IOPLADS: DC 4F'0'; % INPUT OUPUT PARM LIST PUT GET PUTADD: DC A(PDATA); % ADDRESS POINTER TGETADD: DC A(KERMTGET); % ADDRESS FOR ATTACH PUTLEN: DC H'0'; % NUMBER OF CHARACTERS IN DATA LASTTAB: DC H'0'; % LAST TAB FOR SENDS TABADDR: DS A; % ADDRESS OF TABBING BUFFER LASTADDR: DS A; % ADDRESS OF PLACE IN REC BUFFER TABBING ECBREAD: DC F'0'; TASKADD: DS A; % ASYNC TASK ADDRESS ECBTGET: DC F'0'; ECBTREAD: EQU X'AA'; % DO A READ ECBTIMER: EQU X'BB'; % TIME OUT ECB TABCNT: DS H; % TAB COUNTER GETADD: DC A(BUF); % ADDRESS OF GET BUFER TSOADD: DS A; % TSO ADDRESS OF LOAD MOD GETLINAD: DS A; % ADDRESS OF GET LINE ROUTINE CPPLADD: DS A; % ADDRESS OF COMMAND PROCESSOR PARM LIST GETLEN: DS H; % LENGTH OF GET BUFFER ADDBUF: DC A(BUF); % ADDRESS OF BUFFER BUFADCON: DC A(BUF); % ADDRESS OF BUFFER TGETBUFA: DC A(TGETBUFF); TGETLEN: DS F; % LENGTH OF RECEIVED DATA FROM TGET SETADD: DC A(SETLABEL); % ADDRESS OF SET AREA BUFADD: DS F; % POINTER TO PLACE IN BUF BUFCNT: DS H; % NUMBER OF CHARACTERS IN BUFCNT RDATALEN: DS H; % COUNTER OF RECEIVED DATA RDATAADD: DS F; % ADDRESS POINTER TO DATA DACKRC: DS F; % RETURN FROM DYNAL ALLOCATE MAXPUT: DC H'91'; % MAX CHARACTERS TO PUT MAXWRITE: DS H; % MAXIMUM SIZE OF WRITE TO DISK BCCLEN: DC H'1'; % LEN OF VARIOUS BCC CHECKING OLDBCC: DC H'0'; % SAVE BCC VALUE TRFBCC: DS X; % TRANSFER BCC LFCR: DC X'234D234A'; % LIN FEE C R LFCRLEN: EQU *-LFCR; REPTBUFF: DS CL120; % BUFFER FOR REPEAT CHARACTER OLDSEQ: DS H; % PREVIOUS SEQ NUMBER SNDPKT: DS CL130; % SEND THIS TO MICRO; ORG SNDPKT; PHDR: DS X; PLEN: DS X; PNUM: DS X; PTYPE: DS X; PDATA: DS 0C; ORG ,; RECPKT: DS CL130; % RECEIVE THIS FROM MICRO; ORG RECPKT; RMARK: DS X; % RECEIVE MARK RLEN: DS X; % RECEIVE LENGTH RSEQ: DS X; % RECEIVE SEQUENCE NUMBER RTYPE: DS X; % RECEIVE TYPE % THESE LENGTHS ARE FOR FIXED LENGTH MESSAGES YLEN: EQU *-RSEQ; % ACK LENGTH NLEN: EQU *-RSEQ; % NACK LENGTH ZLEN: EQU *-RSEQ; % EOF PACKET LENGTH CLEN: EQU *-RSEQ; % COMPLETE PACKET LENGTH BLEN: EQU *-RSEQ; % EOT PACKET LENGTH ALEN: EQU *-RSEQ; % ABORT PACKET LENGTH RDATA: DS 0C; ORG ,; % RESET ORG COUNTER LSDAT: DS F; % SEND PACKET SIZE; LRDAT: DS F; % RECEIVE PACKET SIZE; EDCNTRL: DS F; % FOR EDIT ROUTINES EDRETURN: DS F; % RETURN CODE EDTYPE: DS F; % EDIT TYPE EDCOL1: DS F; % 1ST COLUMN POSTION EDCOL2: DS F; % 2ND COLUMN POSITION EDLMAX2: DC F'132'; % MAX OF LINE EDLENACT: DS F; % AMOUNT RECEIVEDD EDLINE: DS CL132; % DATA FROM ERROR MESSAGE EDLINENO: DS F; % LINENUMBER RETURNED FROM EDGET EDPNTR: DS F; % POINTER TO DATA ADDRESS EDLINEN: DC XL4'FFFFFFFF'; % LINE NUMBER OF PUT AUTO EDLINER: DS F; % LINE NUMBER RETURNED FROM PUT EDLEN: DS F; % LENGTH FOR PUT OTHERLEN: DS H; % USED IN FILL DPCK SEQNUM: DS H; % NUMBER OF PACKET RPSEQ: DS H; % REC PACKET NUMBER RECLEN: DS H; % LENGTH OF REC DATA RECPNTR: DS F; % POINTER TO RECEIVED DATA LENERROR: DC XL4'FFFFFFEE'; % LENGTH ERROR FLAGS: DC X'00'; % USE TO TEST OUR FLAGS; FLAGS2: DC X'00'; % USE TO TEST OUR FLAGS2; NAME: DC 18X'20'; % NAME OF FILE(S) TO SEND; DS 0F; DS 0F; INPUT: DS CL130; % INPUT BUFFER; INPUT2: DS CL130; % INPUT BUFFER; DS 0F; DS F; % RDW FOR VARIABLE RECORDS; DS F; % RDW FOR VARIABLE RECORDS; N: DC F'0'; % SEND PACKET NUMBER; NUM: DC F'0'; % RECEIVE PACKET NUMBER; RETRY: DC F'20'; % RETRY COUNTER NUMTRY: DC F'0'; % TRIAL COUNTER FOR TRANSFERS; OLDTRY: DS F; % COUNTER FOR PREVIOUS PACKET; STORLOC: DS F; % POINTER TO EXTRA STORAGE; MAXPACK: DC F'94'; % MAX PACKET SIZE; RECL: DS F; % RECORD LEN (IF RECFM = V); RPSIZ: DC F'94'; % MAX RECEIVE PACKET SIZE; DSSIZ: DC F'40'; % DEFAULT MAX SEND PACKET SIZE MAXTRY: DC F'5'; % NO. OF TIMES TO RETRY PACKET IMXTRY: DC F'16'; % NO. OF INITIAL TRIALS ALLOWE SIZE: DS F; % MAX SIZE FOR SEND DATA; CRTLINE#: DS H; % SCREEN LINE NUMBER IN SHOW MAXCRC#: DC H'11'; % MAX LINES ON SCREEN FOR SHOW AT PRESENT RECSEQ: DC H'0'; % NUMBER COUNTER DEL: DC F'127'; % OCTAL 177 (DELETE CHAR); MOD64: DC XL4'0000003F'; % MODUL 64 ASCIIONE: DC X'31'; % ASCII LIT 1 ASCII2: DC X'32'; % ASCII LIT 1 ASCII3: DC X'33'; % ASCII LIT 1 ZERO: DC F'0'; ONE: DC F'1'; ONETHOU: DC F'1000'; FIVE: DC F'5'; SIX: DC F'6'; TWO: DC F'2'; THREE: DC F'3'; % CONSTANT FOR EDSETS FOUR: DC F'4'; % " ONEOONE: DC F'101'; % FOR EDIT ROUTINES TEN: DC F'10'; SPACE: DC F'32'; % ASCII SPACE; O1H: DC F'64'; % OCTAL 100; O2H: DC F'128'; % OCTAL 200; SAVPL: DC F'0'; % POINTER WITHIN BUF,INIT=0; RSAVPL: DC F'0'; % POINTER IN 'PTCHR',INIT=0; RCRCREAL: DS H; % RECEIVE CHARACTER DQUOTE: DC X'23'; % DEFAULT QUOTE CHARACTER = #; QUOCHAR: DS X; % QOUTE CHAR WE'LL SEND; RQUO: DS X; % MICRO'S QUOTE CHAR; DOT: DC C'.'; % DOT FOR DS NAME SCAN DBINQC: DC X'26'; % DEFAULT 8 BIT QUOTE CHAR = & BINQC: DC X'26'; % 8 BIT QUOTE CHARACTER DTABCHAR: DC X'09'; % ASCII HT TABCHAR: DS X; % TABCHAR TABCHAR#: DC X'49'; % ASCII HT+ CNTL QUOTE VALUE TEMP: DS D; % TEMPORARY SPACE; DS 0D; SDAT: DS CL130; % TEMP PLACE FOR SEND DATA; RDAT: DS CL130; % TEMP PLACE FOR RECEIVE DATA; FILNAML: DS H; % LENGTH OF FILENAME; FILNAM: DS CL18; % SEND/REC FILENAME; STATE: DS C; % OUR CURRENT STATE; DEOL: DC X'0D'; % DEFAULT END OF PACKET (CR); REOL: DS X'0D'; % EOL CHAR I NEED (CR); SEOL: DS X'0D'; % EOL I'LL SEND; QBINCHAR: DC X'26'; % EIGHTTH BIT QUOTE CHARA DQBIN: DC X'26'; % EIGHTTH BIT QUOTE CHARACTER; DREPT: DC X'7E'; % ASCII ~ REPTCHAR: DS X; % CHARACTER USED FOR REPEAT QUOTING DCAPA1: DC X'0'; % CAPABILITIES ZERO NOW DSOH: DC X'01'; % DEFAULT START OF HEADER (CTL RSOH: DS X; % RECEIVE START OF HEADER; SSOH: DS X; % SEND START OF HEADER; DLRECL: DC H'504'; % DEFAULT LRECL SIZE OF 80; LRECL: DS H'255'; % LRECL PROGRAM WILL USE; DBLKSIZE: DC H'6356'; % DEFAULT BLKSIZE OF 6356; BLKSIZE: DS H; % BLKSIZE PROGRAM WILL USE; DTRACK: DC F'5'; % DEFAULT SPACE ALLOCATION; DRECFM: DC CL2'VB'; % W DEFAULT WITH VARIE RECFM; RFM: DC CL2'UB'; % RECFM PROGRAM WILL USE; RRECFM: DS C; % REC FORMAT OF FILE IN USE VOLUME: DC CL7'TMP '; % JDW VOLUME FOR ALLOCATE; OUTUNIT: DC CL8'FILE '; % FOR DYNAL OUTSTATS: DS X; % STATUS FOR DYNAL OUTNDISP: DS X; % NORMAL DISPOSITION DYNAL OUTCDISP: DS X; % CONDITIONAL DISPOSITION DYNAL DATA: DC CL7'TEXT '; % JDW DATA TYPE BIN OR TEXT; % DALRTVOL: DS CL6; % VOL SERIAL OF RETURNED DYNAL BLIP: DS X; % SAVE USER'S BLIP CHAR; LINSIZ: DS F; % SAVE USER'S CONSOLE LINESIZE %STYPE: DS C; % TYPE OF PACKET SENT; %RTYPE: DS C; % TYPE OF PACKET RECEIVED; READSAVE: DS 4F; WRITSAVE: DS 4F; PARSELST: DS 3F; % PTRS TO OPERAND STACK; PTRTBL: DS 15F; % OPERAND STACK; PTRTBLL: EQU *-PTRTBL; % LENGTH OF PTRTBL; DBLWRK: DS D; IDSYS: DC F'2'; % MVS TSO; DDNAME: DC CL8' '; % DDNAME TO ALLOCATE; DSNAME: DC CL80' '; % DSNAME TO ALLOCATE; DSMEMBER: DC CL8' '; % MEMBER NAME DSNAMEX: DC CL80' '; % WRKBUFFER; MEMBER: DC CL8' '; % MEMBER NAME FOR PDS ALLOC; LASTDSN: DC CL44' '; % FOR THE WILDCARD SEND DISP1: DC F'2'; % DISP (0=NEW,1=OLD,2=SHR); DISP2: DC F'3'; % DISP (0=UNCAT,1=CAT,3=KEEP); INOUT: DC F'2'; % 0=INPUT,1=OUTPUT,2=INOUT); RECFMX: DC F'1'; % 1=FB,2=VBS; BLKSIZEX: DC F'3600'; % FOR NEW DATA SETS ONLY; LRECLX: DC F'80'; % ....; DEV: DC CL8'FILE '; % DEVICE; TRACK: DC F'20'; % # TRACKS TO ALLOC FOR NEW DS DYNALCRC: DC F'0'; % RETURN CODE FROM FUNCTION; VOLAD: DC F'0'; % ADDRESS OF VOLUME FOR DYNAL; WRKBUFF: DS CL280; PREFIX: DC CL44' '; % USERS DSET PREFIX FROM SET PREFIXL: DC H'0'; % PREFIX LENGTH-1; PREFMEM: DS CL8; % MEMBER NAME FOR PDS PREFIX PREFMEML: DC H'0'; % LENGTH OF PREFIX PDS MEMBER DSNPFIX: DC CL44' '; % PREFIX IF WILDCARD SEND DSNPFL: DC H'0'; % PREFIX LENGTH DSNSFIX: DC CL44' '; % SUFFIX LENGTH DSNSFL: DC H'0'; % SUFFIX LENGTH MATCHDSN: DC CL44' '; % NAME TO MATCH MATCHDSL: DS H; % LENGTH OF MATCHNAME DDELAY: DC F'2000'; % DEFAULT DELAY TIME; DELAY: DS F; % DELAY TIME; DC CL8'CRC*****'; % DUMP BUSTERS BCC: DS F; % FOR BCC COMP TIMEOUT: DC F'8'; % TIMEOUT FOR OTHER KERMIT TIMEOUT2: DC F'800'; % TIMEOUT FOR OTHER KERMIT RTIMEOUT: DC F'800'; % RDATA TIMEOUT ATIMEOUT: DC F'50'; % ATTACH TIMEOUT SERVTOUT: DC F'3000'; % SERVER TIMEOUT FOR NACKING 30 SECONDS SERVWAIT: DC F'720000' ; % SERVER LOGOFF AFTER SIXTY MINUTES SERVTIME: DC F'0' ; % TIME BUFFER FOR SERVER STURNTIM: DC F'100'; % SEND TURN TABLE RTURNTIM: DC F'100'; % RECEIVE TURN TABLE DSNLEN: DS H; % LENGTH OF DSNAME DSNADD: DS A; % ADDRESS OF DSNAME PARM1: DC F'1'; % NO DUMP - TSO COMMAND =1 PARM2: DS CL255; % COMMAND STRING PARM3: DC F'0'; % LENGTH OF COMMAND STRING PARM4: DS F; % RETURN CODE HERE PARM5: DS F; % SERVICE RETURN CODE PARM6: DS F; % ABEND CODE KERMDDNM: DS CL8; % DDNAME BUFFER DSNSIZE: EQU 44; % LEN OF DSNAME LEVELCK: DC X'01'; % ASCII BCC LEVEL CH 1 HIGHBCC: DC X'03'; % HIGHEST BCC WE SUPPORT DBCC: DC X'03'; % DEFAULT BCC CHECKING BLANKS: DC 100CL1' '; % BLANKS ASCBLANK: DC 100XL1'20'; % BLANKS AAAAIII: DS XL7; % USER ACCOUNT AND INITIALS DC CL1'.'; % DOT FOR THE DSNAME USERPREA: DC A(AAAAIII); USERPREL: DC H'7'; % LENGTH OF USER PREFIX TMPDISKA: DC A(TMPVOLID); % INSTALLATION DEFAULT DISK DRIVE NAME TMPDISKL: DC H'3'; % LENGTH OF TMP NAME TMPVOLID: DC CL3'TMP'; % REMOVEME TSOCMDA: DS A; % ADDRESS OF TSO COMMAND TO ISSUE TSOCMDL: DS H; % LENGTH OF TSO COMMAND XUSERPRO: AREA H,DSECT=NO; DC CL3'EX '; USERPROF: DS 0X; % LABEL FOR USERPROFILE NAME DC C'KERMIT.PROFILE.CLIST'; USERPROL: EQU *-USERPROF; % LENGTH OF NAME XUSERPRL: EQU *-XUSERPRO; % LENGTH OF COMMAND AREAEND; % LENGTH OF COMMAND XSYSPRO: AREA H,DSECT=NO; DC CL3'EX '; % EXECUTE COMMAND FOR PROFILE OF SYSTEM DC CL1'"'; % QUOTE AROUND DSNAME DC CL1'"'; % QUOTE AROUND DSNAME XSYSPROL: AREAEND 0X; STATBUFF: DC CL256' '; % FINAL STATUS OF KERMIT CATDSPTR: DS A; % ADDRESS OF PLACE IN CATALOG BUFFER STATLEN: DS H; WARNBUFF: DC CL255' '; % WARNING BUFFER WARNLEN: DS H; WARNAD1: DC A(0); % WARNING BEGINNING OF CHAIN WARNADL: DC A(0); % ADDRESS OF LAST WARNING ENTRY SUCESSCC: DC C'TSO KERMIT completed successfully'; ATOEVCON: DC V(ATOETBL); % ASCII TO EBCIDIC TRANSLATE TABLE ETOAVCON: DC V(ETOATBL); % EBCIDIC TO ASCII TRANSLATE TABLE ADD ETOAERRV: DC V(ETOAERRT); % TABLE OF UNTRANSLATABLE CHARACTERS BAL; *; % TABLE TO TRANSLATE TO UPPER CASE *; UPPER DC 256AL1(*-UPPER) ORG UPPER+X'81' DC C'ABCDEFGHI' ORG UPPER+X'91' DC C'JKLMNOPQR' ORG UPPER+X'A2' DC C'STUVWXYZ' ORG *; % THIS IS THE ASCII TO EBCDIC TABLE ATOE DC X'00010203372D2E2F1605250B0C0D0E0F' DC X'101112133C3D322618193F271C1D1E1F' DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' NIH JDW DC X'79818283848586878889919293949596' NIH JDW DC X'979899A2A3A4A5A6A7A8A98B4F9BA107' NIH JDW DC X'00010203372D2E2F1605250B0C0D0E0F' NIH JDW DC X'101112133C3D322618193F271C1D1E1F' NIH JDW DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' NIH JDW DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' NIH JDW DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' NIH JDW DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' NIH JDW DC X'79818283848586878889919293949596' NIH JDW DC X'979899A2A3A4A5A6A7A8A98B4F9BA107' NIH JDW *THIS IS THE EBCDIC TO ASCII CONVERSION TABLE *CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A X'3A' * 0 1 2 3 4 5 6 7 8 9 A B C D E F ETOA DC X'000102033A093A7F3A3A3A0B0C0D0E0F' 0 EBCDIC DC X'101112133A0A080018193A3A1C1D1E1F' 1 TO NI DC X'3A3A3A3A3A0A171B3A3A3A3A3A050607' 2 ASCII DC X'3A3A163A3A3A3A043A3A3A3A14153A1A' 3 NI DC X'203A3A3A3A3A3A3A3A3A3A2E3C282B7C' 4 NI DC X'263A3A3A3A3A3A3A3A3A21242A293B5E' 5 NI DC X'2D2F2D3A3A3A3A3A3A3A3A2C255F3E3F' 6 NI DC X'3A3A3A3A3A3A3A3A3A603A2340273D22' 7 NI DC X'3A6162636465666768693A7B3A3A3A3A' 8 DC X'3A6A6B6C6D6E6F7071723A7D3A3A3A3A' 9 DC X'3A7E737475767778797A3A3A3A5B3A3A' A NI DC X'3A3A3A3A3A3A3A3A3A3A3A3A3A5D5E3A' B NI DC X'3A4142434445464748493A3A3A3A3A3A' C DC X'3A4A4B4C4D4E4F5051523A3A3A3A3A3A' D DC X'5C3A535455565758595A3A3A3A3A3A3A' E NI DC X'303132333435363738393A3A3A3A3A3A' F SPACE 1 * * THIS IS TABLE FOR SEARCHING FOR SPECIAL CHARACTER * QUOTING - TRT FOR QUOTE,BINARY, OR REPEAT RECTABLE DC 256X'00' * ALP; TMPDSMES: AREA H,DSECT=NO; DC C'Data set '; TMPDSN: DS CL44; DC C' is on Volume '; TMPVOL: DS CL6; % RETURN ED VOL SERIAL NUMBER TMPMSL: AREAEND; BAL; DATASET CAMLST NAME,DSNAME,,WRKBUFF DELDSN CAMLST SCRATCH,DSNAME,,WRKBUFF,,OVRD UNCAT CAMLST UNCAT,DSNAME ALP; PARMLEN1: EQU *-PARMS; WORK2: DS 0F; % WORK AREA 2 DDSN: DS CL44; % DELETE DSNAME VOLIST: DC H'1'; % ONE VOLUME ON LIST TSOVOL: DS CL6; % VOLUME KERMVA: VAREA; % THE V AREA FOR MACROS KERMBUFF: DS CL80; % BUFFER FOR VOUT SCT: DS 0F; SCT; STACK: DS 1024X'FF'; OSAVE: DC A(0); %%WORKING STORAGE %% SOME LITS FOR SEND TABLE SENDTBL: AREA F,DSECT=NO; DC 256AL1(0); % FILL ARRAY WITH ZEROS ORG SENDTBL; DC 32AL1(ASCIIQUO); % CONTROL QUOTE ORG SENDTBL+127; DC AL1(ASCIIQUO); % THE DELETE CHARACTER ORG SENDTBL+128; % CONTROL + 8BIT DC 32AL1(ASCIQUO8); % CONTROL + 8BIT DC 95AL1(ASCI8BIT); ORG SENDTBL+255; % CONTROL + 8BIT DC AL1(ASCIQUO8); % CONTROL + 8BIT SENDTBLL: AREAEND; REPTABLE: AREA F,DSECT=NO; % THESE LENGTHS ARE ALEAST THE NUMBER DC 256AL1(4); % FILL ARRAY WITH 4'S WORTH WHILE TO QUOTE ORG REPTABLE; % LESS THAN THESE WOULDN'T BE WORTHWHILE DC 32AL1(3); % CONTROL QUOTE ORG REPTABLE+127; DC AL1(3); % THE DELETE CHARACTER ORG REPTABLE+128; % CONTROL + 8BIT DC 32AL1(2); % CONTROL + 8BIT DC 95AL1(3); ORG REPTABLE+255; % CONTROL + 8BIT DC AL1(2); % CONTROL + 8BIT REPTABLL: AREAEND; TABTBLAD: DC A(TABTABLE); % ADDRESS OF TAB TABLE TABWRKA: DS D; % WORK AREA FOR TAB ROUTINE TABTABLE: AREA H,DSECT=NO; % HALF WORD TABLE OF TAB SETS DC 256AL1(0); TABTLEN: AREAEND; ASTRKTBL: AREA H,DSECT=NO; % SHACT TABLE FOR ********** IN WILDCAR DC 256AL1(0); ORG ASTRKTBL+C'*'; % THE "*" DC AL1(4); ORG ,; % RESET COUNTER AREAEND; SERVCOMM: AREA F,DSECT=NO; % TABLE FOR SERVER COMMANDS DC 256AL1(0); % ZERO TABLE ORG SERVCOMM+YOFF; DC AL1(YCASE); % ACK PACKET ORG SERVCOMM+NOFF; DC AL1(NCASE); % NACK PACKET ORG SERVCOMM+GOFF; DC AL1(GCASE); % SERVER GENERIC COMMANDS ORG SERVCOMM+R2OFF; DC AL1(R2CASE); % SERVER GET COMMAND ORG SERVCOMM+IOFF; DC AL1(ICASE); % SERVER I PACKET ORG SERVCOMM+ROFF; DC AL1(SCASE); % SENDINIT PACKET ORG ,; % RESET COUNTER AREAEND; COMMAND: AREA F,DSECT=NO; % TABLE FOR COMMANDS DC 256AL1(0); % ZERO TABLE ORG COMMAND+YOFF; DC AL1(YCASE); % ACK PACKET ORG COMMAND+NOFF; DC AL1(NCASE); % NACK PACKET ORG COMMAND+FOFF; DC AL1(FCASE); % FILE INIT PACKET ORG COMMAND+DOFF; DC AL1(DCASE); % DATA PACKET ORG COMMAND+ZOFF; DC AL1(ZCASE); % EOF PACKET ORG COMMAND+COFF; DC AL1(CCASE); % COMPLETEPACKET ORG COMMAND+BOFF; DC AL1(BCASE); % EOT PACKET ORG COMMAND+EOFF; DC AL1(ECASE); % ERROR PACKET ORG COMMAND+AOFF; DC AL1(ACASE); % ABORT PACKET ORG COMMAND+ROFF; DC AL1(SCASE); % SENDINIT PACKET ORG ,; % RESET COUNTER AREAEND; KOUTADDR: DC A(KERMVOUT); % ADDRESS OF OUTPUT ADDSTATA: DC A(ADSTATUS); % ROUTINE TO ADD TO STATUS BUFFER ASCILITS: AREA H,DSECT=NO; % TABLE OF VALUES FOR SHOW ROUTINE DC CL3'NUL'; DC CL3'SOH'; DC CL3'STX'; DC CL3'ETX'; DC CL3'EOT'; DC CL3'ENQ'; DC CL3'ACK'; DC CL3'BEL'; DC CL3'BS '; DC CL3'HT '; DC CL3'LF '; DC CL3'VT '; DC CL3'FF '; DC CL3'CR '; DC CL3'SO '; DC CL3'SI '; DC CL3'DLE'; DC CL3'DC1'; DC CL3'DC2'; DC CL3'DC3'; DC CL3'DC4'; DC CL3'NAK'; DC CL3'SYN'; DC CL3'ETB'; DC CL3'CAN'; DC CL3'EM '; DC CL3'SUB'; DC CL3'ESC'; DC CL3'FS '; DC CL3'GS '; DC CL3'RS '; DC CL3'US '; ASCLITLN: AREAEND; ASCCNTLC: AREA H,DSECT=NO; % TABLE FOR CONTROL CHARACTER IN SHOW DC CL2'^@'; DC CL2'^A'; DC CL2'^B'; DC CL2'^C'; DC CL2'^D'; DC CL2'^E'; DC CL2'^F'; DC CL2'^G'; DC CL2'^H'; DC CL2'^I'; DC CL2'^J'; DC CL2'^K'; DC CL2'^L'; DC CL2'^M'; DC CL2'^N'; DC CL2'^O'; DC CL2'^P'; DC CL2'^Q'; DC CL2'^R'; DC CL2'^S'; DC CL2'^T'; DC CL2'^U'; DC CL2'^V'; DC CL2'^W'; DC CL2'^X'; DC CL2'^Y'; DC CL2'^Z'; DC CL2'^['; DC CL2'^\'; DC CL2'^]'; DC CL2'^^'; DC CL2'^_'; DC CL2'^`'; ASCCNTLL: AREAEND; CRCCONAD: DC A(CRCCONST); % ADDRESS OF CRC TABLE NOQUADD: DC A(NOQUOTE); % TABLE FOR CONTROL CHARACTERS CIRPARM: AREA F,DSECT=NO; CIROPT: DC X'02'; % OPTION GET NEX LEVEL DATA SET NAME AND VOL DC 2AL1(0); % RESERVED BY SYSTEM CIRLOCRC: DC AL1(0); % LOCATE RETURN CODE CIRSRCH: DC A(LASTDSN); % SEARCH ARG ADDRESS OF LAST DATA SET NAME CIRCVOL: DC F'0'; % ADDRESS OF VOL ALWAYS 0 FORCE CAT LOOKUP CIRWA: DC A(USERWORK); % USER WORK AREA CIRSAVE: DC A(SAVECAT); % SAVE AREA FOR MACRO CIRPSWD: DC F'0'; % ADDRESS OF PASSWORD AREAEND; SAVECAT: DC 18F'0'; % SAVE AREA FOR CATALOG ROUTINE CRCCONST: AREA H,DSECT=NO; % BCC VALUE CONSTANTS % GIVEN BY DIVIDING ANY GIVEN BYTE VALUE BY % THE CCITT POLYNOMIAL X^16+X^12+X^5+1 % THIS VALUE IS THE REMAINDER % DC AL2(0); % 0 DC AL2(4489); % 1 DC AL2(8978); % 2 DC AL2(12955); % 0 DC AL2(17956); % 0 DC AL2(22445); % 0 DC AL2(25910); % 0 DC AL2(29887); % 0 DC AL2(35912); % 0 DC AL2(40385); % 0 DC AL2(44890); % 0 DC AL2(48851); % 0 DC AL2(51820); % 0 DC AL2(56293); % 0 DC AL2(59774); % 0 DC AL2(63735); % 0 DC AL2(4225); % 0 DC AL2(264); % 0 DC AL2(13203); % 0 DC AL2(8730); % 0 DC AL2(22181); % 0 DC AL2(18220); % 0 DC AL2(30135); % 0 DC AL2(25662); % 0 DC AL2(40137); % 0 DC AL2(36160); % 0 DC AL2(49115); % 0 DC AL2(44626); % 0 DC AL2(56045); % 0 DC AL2(52068); % 0 DC AL2(63999); % 0 DC AL2(59510); % 0 DC AL2(8450); % 0 DC AL2(12427); % 0 DC AL2(528); % 0 DC AL2(5017); % 0 DC AL2(26406); % 0 DC AL2(30383); % 0 DC AL2(17460); % 0 DC AL2(21949); % 0 DC AL2(44362); % 0 DC AL2(48323); % 0 DC AL2(36440); % 0 DC AL2(40913); % 0 DC AL2(60270); % 0 DC AL2(64231); % 0 DC AL2(51324); % 0 DC AL2(55797); % 0 DC AL2(12675); % 0 DC AL2(8202); % 0 DC AL2(4753); % 0 DC AL2(792); % 0 DC AL2(30631); % 0 DC AL2(26158); % 0 DC AL2(21685); % 0 DC AL2(17724); % 0 DC AL2(48587); % 0 DC AL2(44098); % 0 DC AL2(40665); % 0 DC AL2(36688); % 0 DC AL2(64495); % 0 DC AL2(60006); % 0 DC AL2(55549); % 0 DC AL2(51572); % 0 DC AL2(16900); % 0 DC AL2(21389); % 0 DC AL2(24854); % 0 DC AL2(28831); % 0 DC AL2(1056); % 0 DC AL2(5545); % 0 DC AL2(10034); % 0 DC AL2(14011); % 0 DC AL2(52812); % 0 DC AL2(57285); % 0 DC AL2(60766); % 0 DC AL2(64727); % 0 DC AL2(34920); % 0 DC AL2(39393); % 0 DC AL2(43898); % 0 DC AL2(47859); % 0 DC AL2(21125); % 0 DC AL2(17164); % 0 DC AL2(29079); % 0 DC AL2(24606); % 0 DC AL2(5281); % 0 DC AL2(1320); % 0 DC AL2(14259); % 0 DC AL2(9786); % 0 DC AL2(57037); % 0 DC AL2(53060); % 0 DC AL2(64991); % 0 DC AL2(60502); % 0 DC AL2(39145); % 0 DC AL2(35168); % 0 DC AL2(48123); % 0 DC AL2(43634); % 0 DC AL2(25350); % 0 DC AL2(29327); % 0 DC AL2(16404); % 0 DC AL2(20893); % 0 DC AL2(9506); % 0 DC AL2(13483); % 0 DC AL2(1584); % 0 DC AL2(6073); % 0 DC AL2(61262); % 0 DC AL2(65223); % 0 DC AL2(52316); % 0 DC AL2(56789); % 0 DC AL2(43370); % 0 DC AL2(47331); % 0 DC AL2(35448); % 0 DC AL2(39921); % 0 DC AL2(29575); % 0 DC AL2(25102); % 0 DC AL2(20629); % 0 DC AL2(16668); % 0 DC AL2(13731); % 0 DC AL2(9258); % 0 DC AL2(5809); % 0 DC AL2(1848); % 0 DC AL2(65487); % 0 DC AL2(60998); % 0 DC AL2(56541); % 0 DC AL2(52564); % 0 DC AL2(47595); % 0 DC AL2(43106); % 0 DC AL2(39673); % 0 DC AL2(35696); % 0 DC AL2(33800); % 0 DC AL2(38273); % 0 DC AL2(42778); % 0 DC AL2(46739); % 0 DC AL2(49708); % 0 DC AL2(54181); % 0 DC AL2(57662); % 0 DC AL2(61623); % 0 DC AL2(2112); % 0 DC AL2(6601); % 0 DC AL2(11090); % 0 DC AL2(15067); % 0 DC AL2(20068); % 0 DC AL2(24557); % 0 DC AL2(28022); % 0 DC AL2(31999); % 0 DC AL2(38025); % 0 DC AL2(34048); % 0 DC AL2(47003); % 0 DC AL2(42514); % 0 DC AL2(53933); % 0 DC AL2(49956); % 0 DC AL2(61887); % 0 DC AL2(57398); % 0 DC AL2(6337); % 0 DC AL2(2376); % 0 DC AL2(15315); % 0 DC AL2(10842); % 0 DC AL2(24293); % 0 DC AL2(20332); % 0 DC AL2(32247); % 0 DC AL2(27774); % 0 DC AL2(42250); % 0 DC AL2(46211); % 0 DC AL2(34328); % 0 DC AL2(38801); % 0 DC AL2(58158); % 0 DC AL2(62119); % 0 DC AL2(49212); % 0 DC AL2(53685); % 0 DC AL2(10562); % 0 DC AL2(14539); % 0 DC AL2(2640); % 0 DC AL2(7129); % 0 DC AL2(28518); % 0 DC AL2(32495); % 0 DC AL2(19572); % 0 DC AL2(24061); % 0 DC AL2(46475); % 0 DC AL2(41986); % 0 DC AL2(38553); % 0 DC AL2(34576); % 0 DC AL2(62383); % 0 DC AL2(57894); % 0 DC AL2(53437); % 0 DC AL2(49460); % 0 DC AL2(14787); % 0 DC AL2(10314); % 0 DC AL2(6865); % 0 DC AL2(2904); % 0 DC AL2(32743); % 0 DC AL2(28270); % 0 DC AL2(23797); % 0 DC AL2(19836); % 0 DC AL2(50700); % 0 DC AL2(55173); % 0 DC AL2(58654); % 0 DC AL2(62615); % 0 DC AL2(32808); % 0 DC AL2(37281); % 0 DC AL2(41786); % 0 DC AL2(45747); % 0 DC AL2(19012); % 0 DC AL2(23501); % 0 DC AL2(26966); % 0 DC AL2(30943); % 0 DC AL2(3168); % 0 DC AL2(7657); % 0 DC AL2(12146); % 0 DC AL2(16123); % 0 DC AL2(54925); % 0 DC AL2(50948); % 0 DC AL2(62879); % 0 DC AL2(58390); % 0 DC AL2(37033); % 0 DC AL2(33056); % 0 DC AL2(46011); % 0 DC AL2(41522); % 0 DC AL2(23237); % 0 DC AL2(19276); % 0 DC AL2(31191); % 0 DC AL2(26718); % 0 DC AL2(7393); % 0 DC AL2(3432); % 0 DC AL2(16371); % 0 DC AL2(11898); % 0 DC AL2(59150); % 0 DC AL2(63111); % 0 DC AL2(50204); % 0 DC AL2(54677); % 0 DC AL2(41258); % 0 DC AL2(45219); % 0 DC AL2(33336); % 0 DC AL2(37809); % 0 DC AL2(27462); % 0 DC AL2(31439); % 0 DC AL2(18516); % 0 DC AL2(23005); % 0 DC AL2(11618); % 0 DC AL2(15595); % 0 DC AL2(3696); % 0 DC AL2(8185); % 0 DC AL2(63375); % 0 DC AL2(58886); % 0 DC AL2(54429); % 0 DC AL2(50452); % 0 DC AL2(45483); % 0 DC AL2(40994); % 0 DC AL2(37561); % 0 DC AL2(33584); % 0 DC AL2(31687); % 0 DC AL2(27214); % 0 DC AL2(22741); % 0 DC AL2(18780); % 0 DC AL2(15843); % 0 DC AL2(11370); % 0 DC AL2(7921); % 0 DC AL2(3960); % 0 AREAEND; %%WORKING STORAGE END SUBTITLE 'KRESET'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % INITIALIZATION ROUTINE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % KRESET: CENTER VRE,HIGHR,ENTRY=NO; BAL; XC N,N SET VARIABLES TO ZERO XC NUM,NUM XC LSDAT,LSDAT XC LRDAT,LRDAT MVI FLAGS,X'00' CLEAR ALL FLAGS XC SAVPL,SAVPL XC RSAVPL,RSAVPL XC NUMTRY,NUMTRY MVC FILNAM,=18X'20' BLANK OUT FILNAM & NAME MVC NAME,=18X'20' XC OLDTRY,OLDTRY XC SIZE,SIZE XC TEMP,TEMP XC STORLOC,STORLOC MVC DELAY,DDELAY SET DEFAULT DELAY MVC LRECL(2),DLRECL SET DEFAULTS, JUST IN CASE MVC BLKSIZE(2),DBLKSIZE SET DEFAULTS, JUST IN CASE MVC TRACK,DTRACK DEFAULT SPACE OF 5 TRACKS MVC RFM(2),DRECFM MVC QUOCHAR(1),DQUOTE MVC TABCHAR(1),DTABCHAR TAB CHARACTER MVC RQUO(1),DQUOTE MVC REOL(1),DEOL MVC SEOL(1),DEOL MVC SSOH(1),DSOH MVC RSOH(1),DSOH MVC BINQC(1),DQBIN EIGTH BIT QUOTE CHARACTER MVI STATE,C' ' * MVI STYPE,C' ' MVI RTYPE,C' ' * ALP; % RETURN TO ALP LAND MZC TABTABLE,TABTLEN; % ZERO TAB TABLE LA XRA,TABTABLE; % POINT AT TABLE LI VR1,10; % TEN ENTRIES IBM STYLE LI VR0,9; % 9 FIRST ENTRY EACH 8 UNITS LONG DO BEGIN STH VR0,0(,XRA); % PUT IN TABLE AI VR0,8; % NEXT ENTRY AI XRA,2 % NEXT POINT IN BUFFER END FOR VR1; MZC RECTABLE,256; % ZERO RECTABLE MMVC SENDTBL,SENDTLIT,256; % INITIALIZE BOTH TABLES MMVC REPTCHAR,DREPT,1; % MOVE IN DEFAULT VALUE FOR REPEAT PREFIX MZC PREFIXL,2; % NO PREFIX SET ZF PREFXQUO; % QUOTED PREFIX SF EDITF; % DEFAULT AS EDIT FILE MMVC EDTYPE,=F'1',4; % TURN OFF LINE NUMBERS MMVC HIGHBCC,DBCC,1; % SET BCC CHECK LEVEL SF TIMERF; % TURN ON TIMER MMVC DATA,=C'TEXT ',6; ZF DATAFLAG; MMVC PHDR,SSOH,1; % INITIALIZE START O HEADER CALL XANYVOL; % EXTERNAL ROUTINE GIVES THE SYSTEM % SYMBOL FOR SYSTEM SELECTING THE VOLUMRE % ON UPLOADED DATA SET (E.G SET VOL TMP - SYSTEM SELECTS ST VR1,TMPDISKA; STH VR0,TMPDISKL; LR XRA,VR0; MFC VOLUME,L'VOLUME; EXI XRA,MMVC,VOLUME,0(VR1),*-*,INCR=YES,DECR=YES; CEXIT VRE,HIGHR; LTORG; KWRDSECT: AREA ,0X; COPY KWR; AREAEND; SENDTLIT: AREA F,DSECT=NO; DC 256AL1(0); % FILL ARRAY WITH ZEROS ORG SENDTLIT; DC 32AL1(ASCIIQUO); % CONTROL QUOTE ORG SENDTLIT+127; DC AL1(ASCIIQUO); % THE DELETE CHARACTER ORG SENDTLIT+128; % CONTROL + 8BIT DC 32AL1(ASCIQUO8); % CONTROL + 8BIT DC 95AL1(ASCI8BIT); ORG SENDTLIT+255; % CONTROL + 8BIT DC AL1(ASCIQUO8); % CONTROL + 8BIT SENDTLTL: AREAEND; SUBTITLE 'PROFILES'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE NAME - PROFILES % FUNCTION - EXECUTE SYSTEM AND USER PROFILES IF ANY VIA LOCATE % INPUTS NONE % OUTPUTS EXECTION OF PROFILE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PROFILES: CENTER VRE,HIGHR,ENTRY=NO; MFC DSNAME,44; % NOW CHECK IF THERE IS A USER PROFILE LH XRA,USERPREL; % LENGTH OF USER PREFIX L XRB,USERPREA; % USER PREFIX NAME EXI XRA,MMVC,DSNAME,0(XRB),*-*,INCR=YES,DECR=YES; % USER + "." LA VR1,DSNAME; AR VR1,XRA; MVI 0(VR1),C'.'; % PUT IN DOT AFTER USER CODE AI VR1,1; MMVC 0(VR1),USERPROF,USERPROL; LOCATE DATASET; IF <RZ VRF> THEN BEGIN % DATASET EXISTS - SO EXECUTE IT VIA TSO LI VR0,XUSERPRL; % LENGTH OF COMMAND CCALL TSOCMD,A,VR1=XUSERPRO; % EXECUTE THE PROFILE COMMAND END; MFC DSNAME,44; % FIRST CHECK IF THERE IS A SYSTEM PROFILE CALL SYSPRODS; % CALL EXTERNAL ROUTINE FOR NAME OF SYSTEM PROFILE IF <RP VR0> & <CLI VR0,45; CC L> THEN BEGIN % MUST HAVE LENGTH LR XRA,VR1; % POINTER TO SYSTEM PROFILE LR XRB,VR0; % LENGTH OF SYSTEM PROFILE EXI XRB,MMVC,DSNAME,0(XRA),*-*,INCR=YES,DECR=YES; LOCATE DATASET; IF <RZ VRF> THEN BEGIN % DATASET EXISTS - SO EXECUTE IT VIA TSO LR VR0,XRB; % LENGTH OF COMMAND AI VR0,5; % LENGTH OF DSN + EX + QUOTES AND BLANKS EXI XRB,MMVC,EXDSN,0(XRA),*-*,INCR=YES,DECR=YES; LA VR1,EXDSN; AR VR1,XRB; MVI 0(VR1),C''''; CCALL TSOCMD,A,VR1=EXBUFFER; % EXECUTE THE PROFILE COMMAND END; MFC DSNAME,44; END; % OF POSITIVE RETURN ON SYSTEM PROFILE DATA BEGIN EXBUFFER: DC CL3'EX '; % THE EXECUTE COMMAND DC CL1''''; % QUOTE AROUND SYSTEM PROFILE EXDSN: DS CL46; % FOR DATA SET NAME END; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'STCKMOD'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: STCKMOD % FUNCTION: CALLS THE STACK MACRO TO PUT INPUT ON STACK % IF ONE EXISTS ON THE COMMAND LINE OF CP % RETURN : ITEM STACKED ON INPUT STACK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% STCKMOD: CENTER VRE,HIGHR,ENTRY=NO; L XRA,CBUFFADD; % ADDRESS LH XRB,0(XRA); % LOAD LENGTH OF COMMAND STRING SI XRB,4; % SUB OFF FOUR FOR HEADER LH XRC,2(XRA); % LOAD OFFSET FOR PARAMETER SR XRB,XRC; % SEE IF A PARAMETER EXISTS IF <RP XRB> THEN BEGIN % WE HAVE ONE AI XRA,4; % POINT TO BEGINING OF COMMAND STRING AR XRA,XRC; % INDEX TO BEGINNING OF PARAMETER % NOW XRA-> PARAMETER % AND XRB= THE LENGTH LA VR0,16(,XRB); % THE LENGTH O VR0,=AL1(78,0,0,0); % SUBPOOL 78 WHERE THE STACK WANTS IT GETMAIN R,LV=(0); % GET THE CORE LR XRC,VR1; % ADDRESS MZC 0(XRC),16; % CLEAR LSD USE XRC AS LSD IN BEGIN AI VR1,16; % INCREMENT PAST LSD ST VR1,LSDADATA; ST VR1,LSDANEXT; % PLANT BUFFER ADDRESS STH XRB,LSDRCLEN; % PLANT RECORD LENGTH STH XRB,LSDTOTLN; % PLANT TOTAL LENGTH END; EXI XRB,MMVC,0(VR1),0(XRA),*-*,INCR=YES,DECR=NO; L XRA,UPTADD; % UPTADDRESS L XRB,ECTADD; % ECT ADDRESS L VRF,STACKADD; STACK STORAGE=((XRC),SOURCE),ENTRY=(15),MF=(E,IOPLADS),_ PARM=STACKLST,UPT=(XRA),ECT=(XRB),ECB=ECBGETLN; DATA BEGIN STACKLST: STACK MF=L; END; % THAT'S ALL FOLKS END; % OF SOMETHING TO STACK CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'KSET'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % MODULE NAME - KSET % % % FUNCTION- MODULE SETS VARIOUS KERMIT OPTIONS % WHICH ARE DISPLAYED VIA THE SHOW COMMAND % % % INPUTS - THE BUFFER 'INPUT' CONTAINS A COMMAND STRING % % % % % OUTPUTS- CORRECTLY SET OPTIONS % % % RETURN % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KSET: ; CENTER VRE,HIGHR,ENTRY=NO; LA XRC,*+4095; USING *+4095-4,XRC; %USING *+4095,XRC; L XRD,SETADD; LA XRE,4095(,XRD); USING SETLABEL+4095,XRE; % LITERALS ADDRESSIBILITY USING SETLABEL,XRD; % ADDRESSIBILITY SCERROR NEW=SETERROR; % ROUTINE FOR SCANNER ERROR VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN; % INIT VAREA FOR OUTPUT SETBLCK: DO BEGIN % MAINLY TO FALL OUT SCAN *; % SCAN FOR SPECIFIC SET COMMAND SCKW DATA,SETDATA,J; % DATA COMMAND SCKW BLOCK,SETBLOCK,J; % BLOCK COMMAND SCKW DEBUG,SETDBUG,J; % DEBUG COMMAND SCKW (HELP,?),SETHELP; % HELP COMMAND SCKW BIT8,SETBIT8,J; % 8 BIT QUOTING Y/N COMMAND SCKW EDIT,SETEDIT,J; % EDIT DATA SET OPTIONS SCKW (TAB,TABS),SETTAB,J; % TAB OPTIONS SCKW (SER,SERVER),SETSER,J; % SERVER MODE OPTIONS SCKW (TIME,TIMER),SETTIME,J; % ENABLE TIMEOUT FEATURE SCKW LRECL,SETLRECL,P; % LRECL COMMAND SCKW BLKSIZE,SETBLK,P,LIMIT=AL1(5); % BLKSIZE COMMAND SCKW SPACE,SETSPACE,P; % SPACE COMMAND SCKW DELAY,SETDELAY,P; % DELAY COMMAND SCKW REOL,SETREOL,P,LIMIT=AL1(3); % RECEIVE EOL COMMAND SCKW SEOL,SETSEOL,P,LIMIT=AL1(3); % SEND EOL COMMAND SCKW SOH,SETSOH,P,LIMIT=AL1(3); % SOH COMMAND SCKW (P,PACK,PACKET),SETPACK,P; % RECEIVE PACKET COMMAND SCKW RECFM,SETRECFM,P,LIMIT=AL1(2); % RECFM COMMAND SCKW CQUOTE,SETQUOTE,P,LIMIT=AL1(3); % QUOTE COMMAND SCKW VOLUME,SETVOL,P,LIMIT=AL1(7); % VOL COMMAND SCKW BQUOTE,SETBINQC,P,LIMIT=AL1(3); % BINARY QUOTE COMMAND SCKW RQUOTE,SETREPTQ,P,LIMIT=AL1(3); % REPEAT QUOTE COMMAND SCKW NUMBERED,DONUMBER; % NUMBERING COMMAND SCKW PREFIX,DOPREFIX; % PREFIX COMMAND SCKW NOPREFIX,NOPREFIX; % PREFIX COMMAND SCKW TURNAROUND,DOTURNRN,J; SCKW ,BADSETKY; % UNKNOWN KEYWORD SCANEND; % END OF SCANNING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % NO PARM ERROR HERE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % WRTERM 'Parameter required for the Set command '; % drop into help message % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET HELP TELLS VARIOUS SET OPTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETHELP: WRTERM 'SET command options are '; WRTERM ' '; % BLANK LINE WRTERM 'Data set attributes '; WRTERM 'DATA - Specifies text or binary file processing.'; WRTERM 'EDIT - Selects WYLBUR edit format or'_ ' non-edit format for received text'; WRTERM 'data sets.'; WRTERM 'NUMBERED - Controls line numbering in non-edit '_ 'format text data sets.'; WRTERM 'TABS - Controls tab processing (tabs to spaces '_ 'receiving, vice-versa sending).'; WRTERM 'RECFM - Record format for received data set'_ ' (non-edit format only).'; WRTERM 'LRECL - Logical record length for received data set'_ ' (non-edit format only).'; WRTERM 'BLKSIZE - Block size for received data set'_ ' (non-edit format only).'; WRTERM 'SPACE - Space allocation for received data set in tracks.'; WRTERM 'VOLUME - Disk volume to store received data set.'; WRTERM 'PREFIX - Prefix to be appended to the start of data'_ ' set names.'; WRTERM 'NOPREFIX - Cancels a previously set prefix.'; WRTERM ' '; WRTERM 'Protocol Attributes '; WRTERM 'DELAY - Timing value for delay before starting send.'; WRTERM 'TIMER - Timeout on received packets.'; WRTERM 'BLOCK - Type of block checking on packets.'; WRTERM 'PACKET - Packet size.'; WRTERM 'CQUOTE - Quote character for control characters.'; WRTERM 'BQUOTE - Quote character for 8th bit quoting.'; WRTERM 'RQUOTE - Quote character for repeat count quoting.'; WRTERM 'SOH - First character of packet.'; WRTERM 'SEOL - Character appended to the end of sent packets.'; WRTERM 'REOL - Character expected at the end of received packets.'; WRTERM 'DEBUG - Sends log of all KERMIT packets '_ 'and disk I/O to a data set.'; WRTERM ' '; WRTERM 'Specific information on each item is '_ 'available by "SET item ?".'; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET DATA FUNCTION BINARY OR TEXT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETDATA: SCKW ?,DATAHELP; % USER NEEDS INFO SCKW (B,BINARY),BINON; % TURN ON INDICATOR SCKW (TEXT,T),BINOFF; % TURN OFF SCKW ,DATAERR; % MISSING PARM BINON: SF DATAFLAG; % TURN ON BINARY INDICATOR MMVC DATA,=C'BINARY',6; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % BINOFF: ZF DATAFLAG; % TURN OFF BINARY INDICATOR MMVC DATA,=C'TEXT ',6; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK DATAHELP: WRTERM 'Sets TEXT (ASCII-EBCDIC conversion) '_ 'or BINARY (no conversion)'; WRTERM 'processing of data.'; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % DATAERR: WRTERM 'Valid options for data are binary or text '; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET BLOCK CHECK TYPE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SETBLOCK: SCKW 1,SETBCC,CODE=AL1(1); SCKW 2,SETBCC,CODE=AL1(2); SCKW 3,SETBCC,CODE=AL1(3); SCKW CRC,SETBCC,CODE=AL1(3); SCKW (HELP,?),BCCHELP; SCKW ,BCCSETER; SETBCC: STC VRE,HIGHBCC; % STORE OFF THE VALUE EXIT FROM SETBLCK; % BCCHELP: WRTERM 'Specifies which type of block checking is used.'; BCCSETER : WRTERM 'Valid options are 1 (1-byte checksum), 2 (2-byte checksum),'; WRTERM '3 (3 byte cyclic redundancy check), or CRC '_ '(synonym for 3).'; EXIT FROM SETBLCK; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET BIT8 FUNCTION ON OR OFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETBIT8: SCKW ?,BIT8HELP; % USER NEEDS INFO SCKW ON,BITON8; % TURN ON INDICATOR SCKW OFF,BITOFF8; % TURN OFF SCKW ,BIT8ERR; % MISSING PARM BITON8: SF BIT8FLAG; % TURN ON WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % BITOFF8: ZF BIT8FLAG; % TURN OFF WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK BIT8HELP: WRTERM 'BIT8 either on/off'; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % BIT8ERR: WRTERM 'BIT8 turns on/off eighth bit quoting '; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET EDIT FUNCTION ON OR OFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETEDIT: SCKW ?,EDITHELP; % USER NEEDS INFO SCKW ON,EDITON; % TURN ON INDICATOR SCKW OFF,EDITOFF; % TURN OFF SCKW ,EDITERR; % MISSING PARM EDITON: SF EDITF; % TURN ON WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % EDITOFF: ZF EDITF; % TURN OFF WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK EDITHELP: WRTERM 'Controls use of WYLBUR edit format for received data sets.'; WRTERM 'Valid options are ON and OFF (default ON).'; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % EDITERR: WRTERM 'Valid SET EDIT parameters are on, off, or help '; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET TIME FUNCTION ON OR OFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETTIME: SCKW ?,TIMEHELP; % USER NEEDS INFO SCKW ON,TIMEON; % TURN ON INDICATOR SCKW OFF,TIMEOFF; % TURN OFF SCKW ,TIMEINT,I,; % GETS ACTUAL VALUE OF TIME FOR TIMER SCKW ,TIMEERR; % MISSING PARM TIMEON: SF TIMERF; % TURN ON WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % TIMEOFF: ZF TIMERF; % TURN OFF WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK TIMEHELP: WRTERM _ 'Controls timeout processing for received packets. TSO KERMIT '; WRTERM _ 'sends a NAK packet after timeout interval expires. After '; WRTERM _ '20 retries, TSO KERMIT terminates the file transfer. Valid'; WRTERM _ 'are OFF (turns off timeout), ON (turns on timeout), or the number'; WRTERM _ 'of seconds to be used for the timeout interval.'; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % TIMEINT: IF <CI VRF,TIMERTOP; CC H> THEN BEGIN WRTERM 'Too large a value for timer - 3600 seconds max'; END % OF ERROR ELSE BEGIN MI VRF,100; % STIMER MACRO USES 100'S OF SECONDS ST VRF,RTIMEOUT; SF TIMERF; END; EXIT FROM SETBLCK; TIMEERR: WRTERM 'Valid SET TIME parameters are on, off, or help '; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET TAB FUNCTION ON OR OFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETTAB: SCKW ?,TABHELP; % USER NEEDS INFO SCKW ON,TABON; % TURN ON INDICATOR SCKW OFF,TABOFF; % TURN OFF SCKW ,TABSCN,B; % CALL SCAN TAB ROUTINE TABON: FREEMAIN RC,SP=18; % FREE TAB BUFFER SF TABF; % TURN ON WORD INDICATOR LA XRA,TABTABLE; % STANDARD TABLE ST XRA,TABTBLAD; % STORE IN ADDRESS THAT TAB ROUTINES USE EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % TABOFF: FREEMAIN RC,SP=18; % FREE TAB BUFFER ZF TABF; % TURN OFF WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK TABHELP: WRTERM _ 'Controls TAB processing on upload or download of text files.'_ ' OFF disables'; WRTERM _ 'TAB processing. ON assumes tabs are set every 8 positions on the '; WRTERM _ 'microcomputer and changes tabs to blanks in received data sets and'; WRTERM _ 'blanks to tabs in transmitted data sets. Tab positions may also '; WRTERM _ 'be specified as "column", "column+interval*count" '_ 'to set a tab at'; WRTERM '"column" and every "interval" columns for "count" times,'; WRTERM '"and/or column+interval/max"'_ ' to set a tab "interval" columns through '; WRTERM 'column "max".'; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % TABSCN: CCALL SCANTABS,A; IF <RNZ VRF> THEN % ISSUE MESSAGE ON ERROR WRTERM 'Invalid SET TAB parameters. Type SET TAB ? for information.' ELSE SF TABF; % INDICATE TABBING EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET SERVER FUNCTION ON OR OFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETSER: SCKW ?,SERHELP; % USER NEEDS INFO SCKW ON,SERON; % TURN ON INDICATOR SCKW OFF,SEROFF; % TURN OFF SCKW ,SERERR; % MISSING PARM SERON: SF SERVERF; % TURN ON WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % SEROFF: ZF SERVERF; % TURN OFF WORD INDICATOR EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK SERHELP: WRTERM 'The SERVER command enables SERVER processing '_ 'TSO KERMIT becomes a slave to micro KERMIT . '; WRTERM 'No set commands available while in Server mode '; WRTERM 'the pc KERMIT issuses a logoff to the Server '; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % SERERR: WRTERM 'Valid SET SERVER parameters are on, off, or help '; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET DEBUG FUNCTION ON OR OFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETDBUG: SCKW ?,DBUGHELP; % USER NEEDS INFO SCKW ON,DBUGON; % TURN ON INDICATOR SCKW OFF,DBUGOFF; % TURN OFF SCKW ,DBUGERR; % MISSING PARM DBUGON: SF DBUGFLAG; % TURN ON WORD INDICATOR % OPEN FILE IF CLOSED IF ^<OPENP DEBUG> THEN BEGIN % FILE OPEN OPEN (DEBUG,(OUTPUT)); IF ^<OPENP DEBUG> THEN BEGIN % FILE OPEN WRTERM 'Unable to open DEBUG - DEBUG disabled'; ZF DBUGFLAG; % TURN OFF WORD INDICATOR END; % OF ERROR OPEN END; % OF OPEN BLOCK EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % DBUGOFF: ZF DBUGFLAG; % TURN OFF WORD INDICATOR % CLOSE FILE IF OPEN IF <OPENP DEBUG> THEN CLOSE DEBUG; % FILE CLOSE EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK DBUGHELP: WRTERM 'SET DEBUG ON dumps all received and sent packets'; % 'all data set'; WRTERM 'plus all data set I/O to a VB data set.'; WRTERM 'The user must allocate the DD name DEBUG '_ 'to a sequential data set.'; WRTERM 'SET DEBUG OFF (default) closes debug data set (if open) '; WRTERM 'and turns off debugging information.'; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % DBUGERR: WRTERM 'Only valid debug options are on/off '; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET VOLUME SERIAL NUMBER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETVOL: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN VOLHELP: WRTERM 'Specifies which disk volume will be used for the'_ ' received data set.'; WRTERM 'VOLUME requires a 6 character volume serial number (e.g.'_ ' FILE24).'; %WRTERM 'TMP means that any TMP volume may be used.'; L XRA,TMPDISKA; LH XRB,TMPDISKL; LA VR1,WRKBUFF; EXI XRB,MMVC,WRKBUFF,0(XRA),*-*,INCR=YES,DECR=YES; AR VR1,XRB; MMVC 0(VR1),=C' means that any ',16; AI VR1,16; EXI XRB,MMVC,0(VR1),0(XRA),*-*,INCR=YES,DECR=YES; AR VR1,XRB; MMVC 0(VR1),=C' volume will be used.',21; AI VR1,21; LR VR0,VR1; LA VR1,WRKBUFF; SR VR0,VR1; TPUT (VR1),(VR0); END % OF HELP ELSE BEGIN IF ^<CI VR0,6> THEN BEGIN % MUST HAVE 6 CHARACTER VOLUME L XRA,TMPDISKA; % ADDRESS OF DEFAULT DISK LH XRB,TMPDISKL; IF <EXI XRB,MCLC,0(VR1),0(XRA),*-*,INCR=YES,DECR=YES> THEN BEGIN MFC VOLUME,L'VOLUME; EXI XRB,MMVC,VOLUME,0(XRA),*-*,INCR=YES,DECR=YES; END ELSE BEGIN % ERROR VOLERR: WRTERM 'VOLUME must have 6 character length'; END; % ERROR END ELSE BEGIN % A GOOD 6 SERIAL MMVC VOLUME,0(VR1),6; % CHANGE VOLUME MVI VOLUME+6,C' '; % BLANK LAST END; % OF GOOD END; % OF NON HELP % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET RECFM V OR F %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETRECFM: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN RECFMHLP: WRTERM 'Record format for received non-edit format data set.'; WRTERM 'Valid Record formats are F, FB, V, VB, VBS or U (default VB).'; % END % OF HELP ELSE BEGIN LR XRA,VR0; % GET LENGTH IF <CLI 0(VR1),C'F'> | % MUST HAVE F CHARACTER RECFM OR <CLI 0(VR1),C'U'> | % MUST HAVE U CHARACTER RECFM <CLI 0(VR1),C'V'> THEN BEGIN % MUST HAVE V CHARACTER RECFM IF <CI VR0,1> THEN MVI RFM+1,C' ' % BLANK IT OUT ELSE <GOTO RECFMERR IF <CLI 1(VR1),C'B'; CC NE>>; % JUMP OUT EXI XRA,MMVC,RFM,0(VR1),0,DECR=YES; % CHANGE RECFM END ELSE BEGIN % RECFM ERROR RECFMERR: WRTERM 'Valid Record formats are F, FB, V, VB ,VBS or U (default VB)'; END; % OF GOOD END; % OF NON HELP % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET QUOTE CHARACTER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETQUOTE: SCINIT (VR1),(VR0); SCAN *; SCKW (HELP,?),CQUOTHLP; SCKW ,CQUOTNUM,PI,LIMIT=AL1(127); SCKW ,CQUOTCHK,P,LIMIT=AL1(1); SCKW ,CQUOTBAD; SCANEND; EXIT FROM SETBLCK; CQUOTHLP: WRTERM 'CQUOTE character (default #) is used for prefixing'_ ' characters with a value lower '; WRTERM 'than 32 decimal in ASCII. Value must be between 33-62 '_ 'or 96-126 decimal,'; WRTERM 'indicating the ASCII code for the character.'_ ' The actual character may'; WRTERM 'also be specified.'; % EXIT FROM SETBLCK; CQUOTCHK: L XRA,ETOAVCON; % ADDRESS OF TABLE MTR 0(VR1),0(XRA),1; % GET ASCII CHARACTER LOADB VRF,0(VR1); % LOAD IT % NOW DROP INTO CHECK CQUOTNUM: % NUMBER IN VRF CCALL CHKCNTL,A,VR0=1; IF <RNZ VRF> THEN BEGIN % UNVALID VALUE CQUOTBAD: WRTERM 'Invalid value - must be between 33-62 - ASCII '_ 'Or 96-126 ASCII '; END; % OF ERROR VALUE % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET BINARY QUOTE CHARACTER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETBINQC: SCINIT (VR1),(VR0); SCAN *; SCKW (HELP,?),BQUOTHLP; SCKW ,BQUOTNUM,PI,LIMIT=AL1(127); SCKW ,BQUOTCHK,P,LIMIT=AL1(1); SCKW ,BQUOTBAD; SCANEND; EXIT FROM SETBLCK; BQUOTHLP: TPUT =C'8th bit quote character (default &&) is used for ',48; WRTERM 'prefixing characters that have their 8th bit on.'; WRTERM 'Value must be between 33-62 '_ 'or 96-126 decimal,'; WRTERM 'indicating the ASCII code for the character.'; WRTERM 'The actual character may also be specified.'; % EXIT FROM SETBLCK; BQUOTCHK: L XRA,ETOAVCON; % ADDRESS OF TABLE MTR 0(VR1),0(XRA),1; % GET ASCII CHARACTER LOADB VRF,0(VR1); % LOAD IT BQUOTNUM: % NUMBER IN VRF CCALL CHKCNTL,A,VR0=2; IF <RNZ VRF> THEN BEGIN % UNVALID VALUE BQUOTBAD: WRTERM 'Invalid value - must be between 33-62 - ASCII '; WRTERM 'Or 96-126 ASCII '; END; % OF ERROR VALUE % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET REPEAT QUOTE CHARACTER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETREPTQ: SCINIT (VR1),(VR0); SCAN *; SCKW (HELP,?),RQUOTHLP; SCKW ,RQUOTNUM,PI,LIMIT=AL1(127); SCKW ,RQUOTCHK,P,LIMIT=AL1(1); SCKW ,RQUOTBAD; SCANEND; EXIT FROM SETBLCK; RQUOTHLP: WRTERM 'Repeat quote character (default ~) is used for '; WRTERM 'prefixing repeated characters.'; WRTERM 'Value must be between 33-62 '_ 'or 96-126 decimal,'; WRTERM 'indicating the ASCII code for the character.'; WRTERM 'The actual character may also be specified.'; EXIT FROM SETBLCK; RQUOTCHK: L XRA,ETOAVCON; % ADDRESS OF TABLE MTR 0(VR1),0(XRA),1; % GET ASCII CHARACTER LOADB VRF,0(VR1); % LOAD IT % NOW DROP INTO CHECK RQUOTNUM: % NUMBER IN VRF CCALL CHKCNTL,A,VR0=3; IF <RNZ VRF> THEN BEGIN RQUOTBAD: WRTERM 'Invalid value - must be between 33-62 - ASCII '; WRTERM 'Or 96-126 ASCII '; END; % OF ERROR VALUE % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET BLOCKING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETBLK: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN BLKHELP: WRTERM 'Block size for received non-edit format data set '_ '(default 6356, max 32760).'; % END % OF HELP ELSE BEGIN CVDTB (VR1),(VR0); % CONVERT THE EBCDIC TO BINARY IF <RMZ VRF> | <CI VRF,32767; CC NL> THEN BEGIN % 32767 HIGHEST VALUE BLKERR: WRTERM 'BLOCKING HIGHEST VALUE = 32767'; END ELSE BEGIN % A GOOD 1 BLK STH VRF,BLKSIZE; % STORE IF OFFF END; % OF SELECT BEGIN END; % OF NON HELP % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET LRECL %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETLRECL: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN LRECLHLP: WRTERM 'Logical record length for received non-edit format data set'; WRTERM '(default 504, max 32760).'; % END % OF HELP ELSE BEGIN CVDTB (VR1),(VR0); % CONVERT THE EBCDIC TO BINARY IF <RMZ VRF> | <CI VRF,32761; CC NL> THEN BEGIN % 32760 HIGHEST VALUE LRECLERR: WRTERM 'LRECL HIGHEST VALUE = 32760-CAN`T BE 0 OR MINUS'; END ELSE BEGIN % A GOOD LRECL STH VRF,LRECL; % STORE IF OFFF END; % OF GOOD END; % OF NON HELP % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET DELAY BEFORE SEND INIT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETDELAY: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN DELAYHLP: WRTERM 'Specifies number of seconds (default 20)'_ ' that TSO KERMIT waits before the '; WRTERM 'first packet is sent by the SEND command.'; % END % OF HELP ELSE BEGIN CVDTB (VR1),(VR0); % CONVERT THE EBCDIC TO BINARY IF <RMZ VRF> | <CI VRF,32767; CC NL> THEN BEGIN % 32767 HIGHEST VALUE DELAYERR: WRTERM 'DELAY HIGHEST VALUE = 32767-CAN`T BE 0 OR MINUS'; END ELSE BEGIN % A GOOD DELAY MI VRF,100; % PUT IN 100TH OF SECONDS ST VRF,DELAY; % STORE IF OFFF END; % OF GOOD END; % OF NON HELP % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET SOH START-OF-HEADER CHARACTER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETSOH: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN SOHHELP: WRTERM 'Sets the Start-of-header character sent at the start of'_ ' each transmitted packet '; WRTERM 'and expected at the start of each received packet.'; WRTERM 'May be specified as decimal value of ASCII '_ 'code (0-31), ASCII control character '; WRTERM 'name (e.g., SOH), or in control key notation (e.g., ^A).'; % END % OF HELP ELSE BEGIN %CVDTB (VR1),(VR0); % CONVERT THE EBCDIC TO BINARY CCALL SETCNTLS,A; IF <RM VRF> | <CI VRF,32; CC NL> THEN BEGIN % 31 HIGHEST VALUE SOHERR: WRTERM 'Valid Values 0-31 decimal'; END ELSE BEGIN % A GOOD 1 SOH STC VRF,SSOH; % STORE IF OFFF STC VRF,RSOH; % RECEIVE SOH STC VRF,PHDR; % STORE OFF IN SEND PACKET END; % OF GOOD END; % OF NON HELP % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET EOL END-OF-LINE CHARACTER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETSEOL: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN WRTERM 'The End-of-line control character '_ 'sent at the end of each transmitted packet.'; WRTERM 'May be specified as decimal value of ASCII '_ 'code (0-31), ASCII control character '; WRTERM 'name (e.g., CR), or in control key notation (e.g., ^M).'; % END % OF HELP ELSE BEGIN CCALL SETCNTLS,A; IF <RM VRF> | <CI VRF,32; CC NL> THEN BEGIN % 31 HIGHEST VALUE EOLERR: WRTERM 'Valid Values 0-31 decimal'; END ELSE BEGIN % A GOOD 1 EOL STC VRF,SEOL; % STORE IF OFFF END; % OF GOOD END; % OF NON HELP EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SETREOL: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN WRTERM 'The End-of-line control character '_ 'expected at the end of each received packet.'; WRTERM 'May be specified as decimal value of ASCII '_ 'code (0-31), ASCII control character '; WRTERM 'name (e.g., CR), or in control key notation (e.g., ^M).'; % END % OF HELP ELSE BEGIN CCALL SETCNTLS,A; IF <RM VRF> | <CI VRF,32; CC NL> THEN BEGIN % 31 HIGHEST VALUE %EOLERR: WRTERM 'Valid Values 0-31 decimal'; END ELSE BEGIN % A GOOD 1 EOL STC VRF,REOL; % RECEIVE EOL END; % OF GOOD END; % OF NON HELP % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET RECEIVE PACKET LENGTH %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETPACK: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN PACKHELP: WRTERM 'Sets the maximum packet length'_ '. Valid Values are 26-94 decimal.'; % END % OF HELP ELSE BEGIN CVDTB (VR1),(VR0); % CONVERT THE EBCDIC TO BINARY IF <CI VRF,26; CC NL> & <CI VRF,94; CC NH> THEN BEGIN % 94 HIGHEST VALU ST VRF,RPSIZ; % STORE IF OFFF END ELSE BEGIN % A ERROR PACKET SIZE PACKERR: WRTERM 'Valid Values 26-94 decimal'; END; % OF GOOD END; % OF NON HELP % EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET SPACE -TRACK ALLOCATIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETSPACE: IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN SPACEHLP: WRTERM 'Space allocation for received data sets'_ ' in tracks (default 5, max 32767).'; % END % OF HELP ELSE BEGIN CVDTB (VR1),(VR0); % CONVERT THE EBCDIC TO BINARY IF <RMZ VRF> | <CI VRF,32767; CC NL> THEN BEGIN % 32767 HIGHEST VALUE SPACEERR: WRTERM 'HIGHEST TRACK VALUE = 32767'; END ELSE BEGIN % A GOOD 1 SPACE ST VRF,TRACK; % STORE IF OFFF END; % OF GOOD END; % OF NON HELP EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET NUMBERS - COLUMN POSITIONS WYL/TSO %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DONUMBER: % COL NUMBERS CCALL SCANNUMS,A; % SET UP NUMBERING EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET PREFIX - PREFIX USED FOR DATA SET NAME %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DOPREFIX: SCTELL; % GET REMAINDER OF STRING CCALL SETPREFX,A; EXIT FROM SETBLCK; % BLOW THIS POP STAND %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SET NOPREFIX %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% NOPREFIX: % DISABLE PREFIX SCTELL; IF <RP VR0> THEN BEGIN SCAN *; SCKW (HELP,?),NOPREFHP; SCANEND; % OTHER PARAMETERS WRTERM 'NOPREFIX has no parameters execept HELP or ?'; EXIT FROM SETBLCK; NOPREFHP: % HELP EM OUT WRTERM 'NOPREFIX cancels prefixing a data set name on send or'_ ' receive.'; EXIT FROM SETBLCK; END; % OF MORE TO SCAN MZC PREFIXL,2; % EASY AY ZF PREFPDSF; ZF PREFXQUO; EXIT FROM SETBLCK; % BLOW THIS POP STAND %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % INVALID SET COMMAND %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % BADSETKY: WRTERM 'Invalid Set Command '_ 'Type in "SET HELP" if you need assistance.'; EXIT FROM SETBLCK; % DROP OUT OF SET BLOCK % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % TURNAROUND TIME %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DOTURNRN: SCKW SON,STRNDON; SCKW SOFF,STRNDOFF; SCKW ROFF,RTRNDOFF; SCKW RON,RTRNDON; STRNDON: SF STURNRND; EXIT FROM SETBLCK; STRNDOFF: ZF STURNRND; EXIT FROM SETBLCK; RTRNDON: SF RTURNRND; EXIT FROM SETBLCK; RTRNDOFF: ZF RTURNRND; EXIT FROM SETBLCK; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SCAN ERROR ROUTINE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SETERROR: % SCAN ERROR ROUTINE SELECT FIRST; <CI VRF,SCTCUE>: <VSEG KERMVA,' Missing parameter for command Set '>; <CI VRF,SCTCLXM>: <SCLAST; VSEG KERMVA,' Parameter too long for command Set '>; ENDSEL ELSE BEGIN VSEG KERMVA,'Illegal value for SET command'; END; SCLAST; % GET LAST TOKEN SCANNNED VSEG KERMVA,(VR1),(VR0); % PLACE IN BUFFER\ VOUT KERMVA; % PRINT IT SETLABEL: DS 0H; % USING LABEL END; % OF SET BLOCK CEXIT VRE,HIGHR; LTORG; EXORG; DROP XRD; % FREE LITERAL REG DROP XRE; % FREE LITERAL REG DROP XRC; % FREE ADDRESSIBILTY REG TIMERTOP: EQU 3600; % TOP LIMIT FOR TIMER SUBTITLE 'SETPREFX'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 % MOD: SETPREFX % FUNCTION: SET PREFIX TO DATA SET NAME FOR UPLOAD % OR DOWNLOAD % INPUT: VR1-> STRING % VR0= LENGTH OF STRING % OUTPUT: VARIABLE PREFIX FILLED AND FLAGS SET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SETPREFX: CENTER VRE,HIGHR,ENTRY=NO; ZF PREFXQUO; ZF PREFPDSF; MZC PREFIXL,2; MZC PREFMEML,2; % ZERO OUT LENGTHS SCINIT (VR1),(VR0); SCERROR NEW=SCPREERR; SCANPREF: DO BEGIN SCAN *; SCKW ?,PREFHELP; % INFORMATION ON PREFIX SCKW ,QPREFIX,QS,LIMIT=AL1(54); % IF QUOTED DATA SET NAME SCKW ,UNQPFIX,LIMIT=AL1(44); % REGULAR DSN SCKW ,SCPREERR,CODE=AL1(8); % TOO LONG PREFIX UNQPFIX: % MTRT TEST FOR ILLEGAL CHARACTERS IN DATA SET NAME LR XRB,VR0; % LENGTH EXI XRB,MMVC,PREFIX,0(VR1),*-*,INCR=YES,DECR=YES; % SAVE DATA SET NAME) STH XRB,PREFIXL; % STORE OFF LENGTH BEGIN SCAN *; SCKW ,PREMEM,PS; % SEE IF MEMBER EXISTS FOR PDS SCKW ,*,B; % ALL DONE BABY PREFHELP: WRTERM _ 'PREFIX sets a data set name prefix for SEND and RECEIVE.'; WRTERM _ 'The parameter is the prefix. No prefix is the default.'; WRTERM _ 'The prefix may also indicate a PDS. SET PRE FILE() causes SEND'; WRTERM 'and RECEIVE data set to use the PDS FILE.'; WRTERM 'NOPREFIX cancels prefixing a data set name on send or'_ ' receive.'; EXIT; % DROP OUT OF BLOCK PREMEM: DEBLANK VR1,VR0; %MTRT TEST FOR VALID DSN AGAIN IF <RZ VR0> THEN SF PREFPDSF % HAVE A PDS ELSE BEGIN SCPUSH; SCINIT (VR1),(VR0); SCAN; LR XRA,VR0; % LENGTH FOR EXECUTE IF <CI VR0,8; CC H> THEN BEGIN % MEMBER NAME TOO LONG WRTERM 'Member name excedes 8 characters'; MZC PREFIXL,2; % ERROR CITY EXIT; % SPLIT THE BLOCK END; % OF ERROR BLOCK EXI XRA,MMVC,PREFMEM,0(VR1),*-*,INCR=YES,DECR=YES; STH XRA,PREFMEML; % LENGTH OF PREFIX MEMBER SCDONE; % ERROR IF MORE JUNK ON LINE SF PREFPDSF; % INDICATE WE HAVE A PDS PREFIX SCPOP; END; % OF ZERO LENGTH ELSE SCANEND; END; EXIT; QPREFIX: SCPUSH; SCINIT (VR1),(VR0); % SAME THING AS FOR UNQUOTED NAME SF PREFXQUO; % INDICATE A QUOTED PREFIX GOTO SCANPREF; % A BIT KLUDGEY FOR NOW SCDONE; SCPOP; EXIT; SCANEND; % DROPS THRU HERE WRTERM 'PREFIX requires a parameter for the prefix of data set'; WRTERM 'names. Enter "SET PREFIX ?" for a more information.'; END; DATA BEGIN % NOTHING SPECIFIED SCPREERR: % ERROR ROUTINE IF <CI VRE,8> THEN LR VRF,VRE; % LENGTH ERROR SELECT FIRST; <CI VRF,SCTCUBQ>: WRTERM 'Unbalanced Quotes on Prefix'; <CI VRF,SCTCUBP>: WRTERM 'Unbalanced Parentheses on Prefix'; <CI VRF,SCTCIXM>: WRTERM 'Exceeds the limits of possible prefix'; ENDSEL ELSE WRTERM 'Error in scan of Prefix'; END; % OF THEN STPREXIT: CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SCANNUMS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: SCANNUMS % FUNCTION: SETS UP NUMBER COMMAND % SCANNUMS: CENTER VRE,HIGHR,ENTRY=NO; SCERROR NEW=BADNUM; NUMBLCK: DO BEGIN % A BLOCK TO FALL OUT OF SCAN *; SCKW ,NUMSOME; SCANEND; WRTERM 'NUMBER command requires parameter '; WRTERM 'enter SET NUMBERED HELP for more information '; EXIT FROM NUMBLCK; NUMSOME: % WE HAVE SOMETHING HERE SCBACK; % RESET POINTERS SCPUSH; % STORE OFF SCANNER POINTERS CALL EDSET,(EDCNTRL,EDRETURN,FOUR,ONE,TEMP,EDLEN); % INSERT MVI EDTYPE,X'FF'; % BLAST NUMBER BIT SCNUMBLK: DO BEGIN SCAN *; SCKW ,DOCOL1,PI; % LOOK FOR COLUMN NUMBER SCKW OFF,OFFCOLS; % NO NUMBERING SCKW (HELP,?),NUMHELP; % HELP COMMAND SCKW (ON,WYLBUR),DOWYL; % WYLBUR SCKW TSO,TSONUM; % TSO NUMBERING SCKW OVERLAY,NUMOVER; % OVERLAY NUMBERS OPTION SCKW INSERT,NUMINSER; % NUMBERING INSERT SCKW MERGE,NUMMERGE; % MERGE NUMBERS SCKW ,BADNUM; % UNKNOWN COMMAND SCANEND; EXIT FROM NUMBLCK; BADNUM: WRTERM 'Illegal Parameter for the SET NUMBERED command '; MMVC EDTYPE,=F'2',4; % RESTORE DEFAULT EXIT FROM NUMBLCK; NUMHELP: MVI EDTYPE,0; % ZERO BYTE WRTERM 'Controls line numbering in non-edit format text data sets.'; WRTERM 'Valid Options are: '; WRTERM ' OFF indicates unnumbered '; WRTERM ' ON or WYLBUR indicates a data set with '_ 'WYLBUR line numbers in default columns'; WRTERM ' WYLBUR m/n indicates '_ 'line numbers in columns m through n'; WRTERM ' TSO indicates '_ 'TSO line numbers in default columns'; WRTERM ' TSO m/n indicates TSO '_ 'line numbers in columns m through n'; WRTERM _ 'Default columns for line numbers are the last 8 for data sets'; WRTERM 'with fixed length records, and the firest 8 for data sets'; WRTERM 'with variable length records.'; EXIT FROM NUMBLCK; DOCOL1: ST VRF,EDCOL1; % STORE OFF FIRST COLUMN SCAN *; % LOOK FOR ENDING COLUMN POSITION SCKW ,DOCOL2,PI; % NEED NEXT COLUMN SCKW ,COLERR; SCANEND; WRTERM 'required second number column omitted '; EXIT FROM NUMBLCK; COLERR: WRTERM 'the second column number must be a non zero integer'; EXIT FROM NUMBLCK; DOCOL2: ST VRF,EDCOL2; % STORE OFF SECOND COLUMN SELECT FIRST; <MCLC EDTYPE,=F'2',4>: MVI EDTYPE+3,X'3'; <MCLC EDTYPE,=F'4',4>: MVI EDTYPE+3,X'5'; ENDSEL; DOWYL: % SET UP WYLBUR NUMBERING IF <CLI EDTYPE,X'FF'> THEN MMVC EDTYPE,=F'2',4 % WYLBUR DEFAULTS ELSE MMVC EDTYPE,=F'3',4; % WE HAVE COLUMN POSTIONS NEXT OF SCNUMBLK; % SCAN SOMEMORE TSONUM: % SET UP TSO NUMBERING IF <CLI EDTYPE,X'FF'> THEN MMVC EDTYPE,=F'4',4 % TSO DEFAULTS ELSE MMVC EDTYPE,=F'5',4; % WE HAVE COLUMN POSTIONS NEXT OF SCNUMBLK; % SCAN SOMEMORE NUMOVER: % OVERLAY NUMBERING CALL EDSET,(EDCNTRL,EDRETURN,FOUR,TWO,TEMP,EDLEN); % OVERLAY NEXT OF SCNUMBLK; % SCAN SOMEMORE NUMINSER: %INSERT NUMBERING CALL EDSET,(EDCNTRL,EDRETURN,FOUR,ONE,TEMP,EDLEN); % INSERT NEXT OF SCNUMBLK; % SCAN SOMEMORE NUMMERGE: % MERGE NUMBERS CALL EDSET,(EDCNTRL,EDRETURN,FOUR,THREE,TEMP,EDLEN); % MERGE NEXT OF SCNUMBLK; % SCAN SOMEMORE OFFCOLS: % TURN OFF NUMBERING MMVC EDTYPE,=F'1',4; % TURN OFF LINE NUMBERS EXIT FROM NUMBLCK; END; % OF SCAN BLOCK END; % OF NUMBLCK CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SCANTABS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SCANTABS % FUNCTION : Scans a parameter string for tab values % get memory for table, % INPUT: none - scanner already called just scan away % % % OUTPUT : VRF=0 good entries in table (TABTBLAD) VRF=4 ERROR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SCANTABS: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; SCANTBLK: DO BEGIN % MAIN BLOCK TO FALL OUT OF SCTYPE NEW=0; SCERROR NEW=BADTABS; GETMAIN RC,LV=256,SP=18; % GET POOL FOR BUFFER IF <CI VRF,4> THEN BEGIN WRTERM 'Not enough memory for tab routine'; EXIT FROM SCANTBLK; END; MZC 0(VR1),256; % ZERO OUT TAB BUFFER LR XRA,VR1; % POINT TO ADDRESS ST VR1,TEMP; % STORE ADDRESS OF STORAGE LI XRB,NUMTABS; % SET FIELD SIZE LR XRC,XRA; ZR XRE; % INDENT ZR XRD; % LENGTH TTABSCAN: DO BEGIN SCAN *; SCKW ,TTABSTAB,(PI),LIMIT=AL1(255); SCKW INDENT,TTABSIND,(P,I),LIMIT=AL2(32767); SCKW LENGTH,TTABSLEN,(P,PI),LIMIT=AL2(32767); SCKW (TAB,TABS),0; % CONTINUE SCAN SCKW ,BADTABS; % INDENT TTABSIND: LR XRE,VRF; SCRTN; % LENGTH TTABSLEN: LR XRD,VRF; SCRTN; % TAB POSITION TTABSTAB: CBAL RTNR,TTABPUT; % STORE TAB POSITION BEGIN SCAN *; SCKW '+',TTABPLUS,(P,PI),LIMIT=AL1(255); SCKW ,*,B; TTABPLUS: ST VRF,TABWRKA+4; % SAVE INCREMENT BEGIN SCAN *; SCKW '/',TTABSLSH,(P,PI),LIMIT=AL1(255); SCKW '*',TTABSTAR,(P,PI),LIMIT=AL1(255); SCKW ,*; SCANEND; END; IF <RP VR0> THEN BEGIN VSEG KERMVA,(VR1),(VR0); VSEG KERMVA,': '; END; WRTERM '"/" OR "*" REQUIRED WITH "+"'; LI VRF,4; EXIT FROM SCANTBLK; TTABSLSH: LR VRE,VRF; % SAVE LIMIT LR VR1,XRC; SI VR1,2; LH VRF,0(VR1); % LAST TAB JDW IF <CR VRF,VRE; CC NL> THEN BEGIN WRTERM 'LIMIT LESS THAN STARTING TAB POSITION'; LI VRF,4; EXIT FROM SCANTBLK; END; FOREVER DO BEGIN A VRF,TABWRKA+4; % ADD INCREMENT NEXT OF TTABSCAN IF <CR VRF,VRE; CC H>; CBAL RTNR,TTABPUT; % STORE TAB END; TTABSTAR: LR VRE,VRF; % SAVE LIMIT LR VR1,XRC; SI VR1,2; LH VRF,0(VR1); % LAST TAB JDW FOR VRE DO BEGIN A VRF,TABWRKA+4; % ADD INCREMENT CBAL RTNR,TTABPUT; % STORE TAB END; SCANEND; END; NEXT OF TTABSCAN; TTABPUT: IF <CI VRF,255; CC H> THEN BEGIN % TAB TOO LARGE WRTERM 'TAB POSITION GREATER THAN 255'; LI VRF,4; EXIT FROM SCANTBLK; END; SI XRB,1; % DECR COUNT IF <RM XRB> THEN BEGIN WRTERM 'MORE THAN NUMTABS TABS SPECIFIED'; LI VRF,4; EXIT FROM SCANTBLK; END; STH VRF,0(,XRC); % PUT TAB IN AREA JDW AI XRC,2; % JDW RGOTO RTNR; SCANEND; END; IF ^<MCLC 0(XRA),=H'0',2> THEN BEGIN % TABS WERE SPECIFIED LI VR0,NUMTABS; DO BEGIN % SORT INTO ASCENDING ORDER ZR XRB; % SET SWAP SWITCH OFF LR XRC,VR0; SI XRC,1; % SET LIMIT LR XRD,XRA; % POINT AT TABS FOR XRC DO BEGIN EXIT IF <MCLC 2(XRD),=H'0',2>; % NO MORE TABS LH VRF,0(,XRD); % PICK UP TAB IF <CH VRF,2(XRD); CC H> THEN BEGIN % OUT OF ORDER LA XRB,2(,XRD); SR XRB,XRA; % SET SWAP SWITCH MMVC 0(XRD),2(XRD),2; STH VRF,2(,XRD); % SWAP END ELSE IF <CC E> THEN BEGIN WRTERM 'TWO TABS SPECIFIED AT SAME COLUMN'; LI VRF,4; EXIT FROM SCANTBLK; END; AI XRD,2; END; LTR VR0,XRB; % NEW LIMIT NEXT IF <CC P>; END; % ADD IN INDENT, CHECK MARGIN LR XRB,XRA; LI XRC,NUMTABS; DO BEGIN LH VR0,0(XRB); % NEXT TAB JDW EXIT IF <RZ VR0>; % NO MORE AR VR0,XRE; % ADD INDENT IF <CI VR0,255; CC H> THEN BEGIN WRTERM 'TAB PLUS INDENT GREATER THAN 255'; LI VRF,4; EXIT FROM SCANTBLK; END; STH VR0,0(,XRB); AI XRB,2; END FOR XRC; END ELSE BEGIN % NO TABS SPECIFIED WRTERM 'No tabs were specified'; LI VRF,4; EXIT FROM SCANTBLK; END; MMVC TABTBLAD,TEMP,4; % SUCCESSFUL RETURN UPDATE TAB TABLE POINTER ZR VRF; END; % OF SCANTBLK SCTYPE NEW=1; DATA BEGIN BADTABS: LI VRF,4; END; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; NUMTABS: EQU 125; % ALLOW THIS MANY TABS SUBTITLE 'KSEND'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % MODULE NAME - KSEND % % % FUNCTION- DRIVER FOR SEND COMMAND DYNAL, OPEN, % FORMATS PACKETS, FILE HEADER, EOF ETC % % % INPUTS - % % % % % OUTPUTS- % % % RETURN % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KSEND: ; CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LA XRC,SNDPKT; USE XRC AS PACKET IN BEGIN % DSECT FOR INIT LA XRD,DATABUFF; USE XRD AS SENDIDST IN BEGIN SENDBLCK: DO BEGIN % GLOBAL SEND BLOCK MZC STATLEN,2; % ZERO OUT STATUS LENGTH ZF WARNINGF; SCTYPE NEW=1; % SCAN ACROSS * IN CASE WILD CARD SEND MVI STATE,SEND; % SEND BLOCK STATE BCCTYPE 1; % 1 BCC BYTE AT END SCERROR NEW=SENDERR; % SCAN OFF DSN SCAN *; SCKW ?,SENDHELP; % INFO SCKW ,SEND1ST,B,LIMIT=AL1(44); % DSN SCANEND; % IF HERE NO DSNAME WRTERM 'SEND Command requires a dsname '; EXIT FROM SENDBLCK; % LEAVE SEND SENDHELP: WRTERM _ 'SEND sends a data set (file) to the microcomputer. A corresponding'; WRTERM 'RECEIVE command must be issued to the microcomputer KERMIT'_ ' after the SEND to'; WRTERM 'TSO KERMIT. The parameter is the data set name '_ 'for the data set to be'; WRTERM 'transmitted. The data set must be cataloged.'; EXIT FROM SENDBLCK; % LEAVE SEND SENDERR: SELECT FIRST; <CI VRF,SCTCLXM>: ERRORCON 'Data Set Name maximum 44 letters '; <CI VRF,SCTCUBQ>: ERRORCON 'Unbalanced quotes in Data Set Name'; ENDSEL ELSE <ERRORCON 'Error in data set name'>; CCALL ERRPACK,A; IF <TF SERVERF> THEN BEGIN CCALL SABORT,A,VR0=LH:RPSEQ; END ELSE TPUT (VR1),(VR0); EXIT FROM SENDBLCK; % ERROR EXIT SEND1ST: % THE BEEF SCTELL; % HOW MUCH IS LEFT ? DEBLANK VR1,VR0,XRA,TYPE=BOTH; % STRIP OFF BLANKS % STORE OFF POINTERS IN CASE MORE FILES ST VR1,DSNADD; % ADDRESS OF DSNAME STH VR0,DSNLEN; % LENGTH OF SCANNED NAME CCALL SCANDSN,A; % ROUTINE SETS UP DSNAME CASE VRF MIN 0 MAX 20 CHECK; 0: BEGIN % A GOOD RETURN; END; 4: BEGIN % GOOD RETURN PLUS PDS % SF PDS; END; 8: BEGIN % WILD CARD END; 12: BEGIN % NO LENGTH ERRORCON 'No length on data set name'; CCALL ERRPACK,A; MVI STATE,SESTATE; IF ^<TF SERVERF> THEN TPUT (VR1),(VR0) ELSE BEGIN CCALL SABORT,A,VR0=LH:RPSEQ; % ABORT END; END; 16: BEGIN % ILLEGAL NAME ERRORCON 'Non standard data set name'; CCALL ERRPACK,A; MVI STATE,SESTATE; IF ^<TF SERVERF> THEN TPUT (VR1),(VR0) ELSE BEGIN CCALL SABORT,A,VR0=LH:RPSEQ; % ABORT END; EXIT FROM SENDBLCK; END; 20: BEGIN % NO MATCHING ENTRIES FROM WILD CARD ERRORCON 'No matches in catalog for wildcard'; CCALL ERRPACK,A; MVI STATE,SESTATE; IF ^<TF SERVERF> THEN TPUT (VR1),(VR0) ELSE BEGIN CCALL SABORT,A,VR0=LH:RPSEQ; % ABORT END; EXIT FROM SENDBLCK; END; ENDCASE ELSE BEGIN % ILLEGAL RETURN ERRORCON 'Illegal data set name. Extra data on line.'; CCALL ERRPACK,A; MVI STATE,SESTATE; IF ^<TF SERVERF> THEN TPUT (VR1),(VR0) ELSE BEGIN CCALL SABORT,A,VR0=LH:RPSEQ; % ABORT END; EXIT FROM SENDBLCK; END; CCALL OPENSDSN,A; % Open next sendfile IF ^<TF SENDDSNF> THEN BEGIN IF <TF SERVERF> THEN BEGIN CCALL SABORT,A,VR0=LH:RPSEQ; % ABORT END ELSE <LH VR0,STATLEN; TPUT STATBUFF,(VR0)>; % OUTPYUT TO SCREEN EXIT FROM SENDBLCK; END; % OF OPEN ERROR IF <TF TABF> THEN BEGIN GETMAIN RC,LV=66000,SP=8; % GET POOL FOR BUFFER IF <CI VRF,4> THEN BEGIN WRTERM 'GET MAIN TAB ERROR ON SEND'; END; MMVC TABCNT,=H'0',2; % INITIALIZE TAB COUNTER ST VR1,TABADDR; % TAB ADDRESS END; % OF TABBING IF ^<TF SERVERF> THEN BEGIN % TIMER ONLY IF NO SERVER MODE VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN; VSEG KERMVA,' Waiting '; % build message L VR1,DELAY; % SET UP DELAY FOR STIMER ZR VR0; DI VR0,100; LR XRA,VR1; CVBTD TEMP,0,(XRA); % CONVERT TO PRINT VSEG KERMVA,(VR1),(VR0); VSEG KERMVA,' seconds before sending. '; VOUT KERMVA; % OUT PUT MESSAGE STIMER WAIT,BINTVL=DELAY; % SET TIMER END; % OF NON SERVER TIMER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % CALL THE SEND SWITCH TABLE DRIVER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CCALL SENDSW,A; %L VR1,RPSIZ; % PACKET SIZE %SI VR1,2; % SUBTRACT HEADER %SH VR1,BCCLEN; % % SUB OFF BCC LENGH THEN %STH VR1,MAXPUT; % MAX DATA SIZE FOR PUT END; % OF SENDBLCK IF <TF TABF> THEN FREEMAIN RC,SP=8; % FREE THE BUFFER SCTYPE NEW=1; % RETURN SCANNER TO NORMAL MODE USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; END; % OF DSECT END; % OF DSECT SENDINIT SUBTITLE 'SENDSW'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SENDSW % FUNCTION : THIS ROUTINE DRIVES THE SEND MODULES, % EACH ROUTINE CHANGES THE STATE % INPUT: % % % OUTPUT : %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SENDSW: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; %MVI HIGHBCC,3; % INDICATE BLOCK CHECK TYPE ZEROSEQ; % ZERO SEQUENCE NUMBER ZERORTRY; % ZERO RETRY MVI STATE,SISTATE; % SEND INIT STATE SSWTBLCK: DO BEGIN % LOOP TILL EXIT SELECT FIRST; <TF STOPF>: <CCALL STOPPROC,A; EXIT FROM SSWTBLCK>; % USER STOP <CLI STATE,SISTATE>: CCALL SINIT,A; <CLI STATE,SFSTATE>: CCALL SFILE,A; % FILE HEADER PACKET <CLI STATE,SDSTATE>: CCALL SDATA,A; % SEND DATA PACKETS <CLI STATE,SZSTATE>: CCALL SEOF,A; % SEND EOF <CLI STATE,SBSTATE>: CCALL SEOT,A; % END OF TRANSMISSION <CLI STATE,SESTATE>: BEGIN % ABORT CCALL SABORT,A,VR0=LH:SEQNUM; EXIT FROM SSWTBLCK; % ABORT END; <CLI STATE,RESTATE>: <CCALL RABORT,A; EXIT FROM SSWTBLCK>; % ABORT <CLI STATE,CSTATE>: EXIT FROM SSWTBLCK; % COMPLETE STATE SPLIT ENDSEL; END FOREVER; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SINIT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SINIT % FUNCTION : Sends the SEND INIT packet and receives % the rinit packet , each sets the options % INPUT: none % % % OUTPUT : state = either 'F' file header || 'S' TRY AGAIN % plus options are set (i.e quotes,repeat, etc) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SINIT: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; ZF ACKX; ZF ACKZ; BUMPRTRY XRA; % Increment retry counter IF <MCLC NUMTRY,RETRY,4; CC NL> THEN % Retry exceeded MVI STATE,SESTATE % Send abort state ELSE SINITBLK: DO BEGIN % Send end of transmisision block MMVC TRFBCC,HIGHBCC,1; LI VR0,SENDINIL; CCALL SPAR,A,VR1=PDATA; % CALL ROUTINE THAT BUILDS PACK SPSPACK AS,SEQNUM,PUTLEN,VR0; % S PACKET,SEND PARAMETERS FOR SPACK TCLEARQ INPUT; % CLEAR INPUT BUFFER CCALL SPACK,A; CCALL RPACK,A; EXIT IF <RNZ VRF> | <TF STOPF>; % Leave if Timeout or Bad BCC ZR XRA; % clear for the case MTRT RTYPE,COMMAND,1; % Scan command type DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK; NCASE: BEGIN % Got a nack LH XRA,RPSEQ; % Load received sequence number IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1; % see if nack for pack+1 STH XRA,RPSEQ; % STORE IN CASE NACK FOR SEQ+1 IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>; % Ok yack case next END; % of nack YCASE: BEGIN % ACK EXIT IF ^<MCLC SEQNUM,RPSEQ,2>; % Wrong packet number ZERORTRY; % % Zero retry counter BUMPSEQ VR0; % Increment packet counter LH VR0,RECLEN; % Length of data CCALL RPAR,A,VR1=RDATA; % %%FIXME SELECT FIRST; <CLI TRFBCC,1>: BCCTYPE 1; <CLI TRFBCC,2>: BCCTYPE 2; <CLI TRFBCC,3>: BCCTYPE 3; ENDSEL; MZC PUTLEN,2; MVI STATE,SFSTATE; % SEND FILE HEADER STATE END; % OF ACK ECASE: BEGIN % Error abort MVI STATE,RESTATE; % RECEIVED ABORT END; ENDCASE ELSE BEGIN ERRORCON 'Illegal packet type received '; CCALL ERRPACK,A; % PUT IN BUFFERS MVI STATE,SESTATE; % ABORT END; END; % OK RETRY END; % of SINITBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SPAR'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SPAR % FUNCTION : Builds the send init packet % % INPUT: none % % % OUTPUT : formatted data area of send init packet %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SPAR: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; L VR1,NOQUADD; % LOAD ADDRESS OF CHARACTERS NOT QUOTED XC 0(255,VR1),0(VR1); % CLEAR BUFFER LA XRC,SNDPKT; USE XRC AS PACKET IN BEGIN % DSECT FOR INIT %%LOAD XRD FROM VR1 - AS DESECT POINTER LA XRD,DATABUFF; USE XRD AS SENDIDST IN BEGIN SINITLAB: SENDIBLK: DO BEGIN % A BLOCK TO FALL OUT OFF %LI VR1,SENDINIL; % SEND INIT DSECT LENGTH %%FIX MAKE VR0 STH VR0,PUTLEN; % LENGTH FOR PUT MMVC RCRCREAL,BCCLEN,2; % STORE OF BCC BCCTYPE 1; L VR1,RPSIZ; % PACKET SIZE CHAR VR1; % CHARACTER FUNCTION STC VR1,MAXL; L VR1,TIMEOUT; % NUMBER OF SECONDS FOR KERM TO TIMEOUT CHAR VR1; % CHARACTER FUNCTION STC VR1,TIME; MVI NPAD,X'20'; % MOVE " " FOR NPAD MVI PADC,X'40'; % MOVE " " FOR PADC ZR VR1; IC VR1,REOL; % EOL CHARACTER CHAR VR1; % PRINTABLE FUNCTION STC VR1,EOLCHAR; MMVC QCTL,QUOCHAR; % MOVE QUOTE CHARACTER MMVC QBIN,BINQC; SELECT FIRST; <CLI TRFBCC,1>: MMVC CHKT,ASCIIONE,1; % BCC LEVEL 1 CHECK <CLI TRFBCC,2>: MMVC CHKT,ASCII2,1; % BCC LEVEL 2 CHECK <CLI TRFBCC,3>: MMVC CHKT,ASCII3,1; % BCC LEVEL 3 CHECK ENDSEL; %%REPT REPEAT CHARACTER MMVC REPT,REPTCHAR,1; % PUT IN REPEAT FUNCTION %%CAPA BIT MAP OF CAPABILITIES ZR VR1; IC VR1,DCAPA1; % CAPABILITIES BYTE CHAR VR1; % ASCII SPACE STC VR1,CAPA1; % NO CAPA FUNCTION NOW END; % OF DSECT END; % OF DSECT END; % OF DSECT USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'RPAR'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : RPAR % FUNCTION : Takes the received init packet and set options % to what we accept (e.g. 8th bit , repeat quoting,etc) % INPUT: none % % % OUTPUT : correctly set options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RPAR: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LA XRA,RDATA; USE XRA AS RECINIT IN BEGIN LI XRB,SENDINIL; % LENGTH OF OUR SEND INIT SR XRB,VR0; % LENGTH OF DATA SENT IF <RP XRB> THEN BEGIN SELECT; <CI XRB,4; CC NL>: MVI RQBIN,AN; % NO BINARY QUOTING <CI XRB,2; CC NL>: MMVC RCHKT,ASCIIONE,1; % LEVEL ONE CHECK <CI XRB,3; CC NL>: MVI RREPT,C' '; % NO REPT <CI XRB,1; CC NL>: MVI RCAPA1,C' '; ENDSEL; END; SELECT FIRST; <MCLC RCHKT,ASCIIONE,1>: BEGIN MVI TRFBCC,1; % 1 BCC BYTE AT END END; <MCLC RCHKT,ASCII2,1>: BEGIN IF <CLI HIGHBCC,2; CC L> THEN BEGIN MMVC RCHKT,ASCIIONE,1; NEXT; END; MVI TRFBCC,2; % 2 BCC BYTE AT END END; <MCLC RCHKT,ASCII3,1>: BEGIN IF <CLI HIGHBCC,3; CC L> THEN BEGIN MMVC RCHKT,ASCII2,1; NEXT; END; MVI TRFBCC,3; % 3 BCC BYTE AT END END; ENDSEL; ZR VR0; IC VR0,RMAXL; % LOAD IN LENGTH UNCHAR VR0; % CHANGE IT TO AN INTEGER SI VR0,2; % SEQ & TYPE BYTES ZR VR1; IC VR1,TRFBCC; % GET BCC LENGTH OF PROPOSED TRANSFER SR VR0,VR1; STH VR0,MAXPUT; % STORE IT OFF IF <CLI STATE,RISTATE> THEN LA VR1,RECTABLE ELSE LA VR1,SENDTBL; % POINTER TO TRANSLATE TABLE IF <MCLC RREPT,REPTCHAR> THEN BEGIN % WE HAVE REPT PREFIXING SF REPTF; % TURN ON INDICATOR ZR VR0; IC VR0,REPTCHAR; % LOAD LITERAL FOR CASE STATEMENT AR VR1,VR0; % POINT TO PLACE IN TABLE % LI VR0,ASCIIQUO; % LOAD HASH % REMOVE ME IF IT WORKS IF <CLI STATE,RISTATE> THEN LI VR0,CASEREPT % REPEAT QUOTING ELSE BEGIN LI VR0,NOQUOQUO; % LOAD HASH DON'T QUOTE REPT CHAR STC VR0,0(VR1); % QUOTE FOR HASH IN TABLE AI VR1,X'80'; % POINT TO HIGH ORDER COMPLEMENT LI VR0,NOQUOQU8; END; STC VR0,0(VR1); END ELSE BEGIN ZF REPTF; % NO REPEAT COUNTING POSSIBLE ZR VR0; IC VR0,REPTCHAR; % LOAD LITERAL FOR CASE STATEMENT AR VR1,VR0; % POINT TO PLACE IN TABLE MVI 0(VR1),0; % QUOTE FOR HASH IN TABLE AI VR1,X'80'; % POINT TO HIGH ORDER MVI 0(VR1),ASCI8BIT; END; % OF NO REPT CHARACTER IF <CLI STATE,RISTATE> THEN LA VR1,RECTABLE ELSE LA VR1,SENDTBL; % POINTER TO TRANSLATE TABLE IF <MCLC RQCTL,QUOCHAR,1> THEN BEGIN % QUOTE CHARACTER PREFIXING ZR VR0; IC VR0,QUOCHAR; % LOAD LITERAL FOR CASE STATEMENT AR VR1,VR0; % POINT TO PLACE IN TABLE % LI VR0,ASCIIQUO; % LOAD HASH % REMOVE ME IF IT WORKS LI VR0,NOQUOQUO; % LOAD HASH DON'T QUOTE REPT CHAR IF <CLI STATE,RISTATE> THEN LI VR0,CASEQUO ELSE BEGIN STC VR0,0(VR1); % QUOTE FOR HASH IN TABLE AI VR1,X'80'; % POINT TO HIGH ORDER COMPLEMENT LI VR0,NOQUOQU8; END; STC VR0,0(VR1); END ELSE BEGIN ZR VR0; IC VR0,QUOCHAR; % LOAD LITERAL FOR CASE STATEMENT AR VR1,VR0; % POINT TO PLACE IN TABLE MVI 0(VR1),0; % QUOTE FOR HASH IN TABLE AI VR1,X'80'; % POINT TO HIGH ORDER MVI 0(VR1),ASCI8BIT; %%% RESTORE HIGH ORDER QUOTE END; % OF QUOTE CHARACTER IF <CLI STATE,RISTATE> THEN LA VR1,RECTABLE ELSE LA VR1,SENDTBL; % POINTER TO TRANSLATE TABLE IF <CLI RQBIN,AY> | %ASCII Y <MCLC RQBIN,BINQC,1> THEN BEGIN % WE HAVE 8BIT PREFIXING ZR VR0; IC VR0,BINQC; % LOAD LITERAL FOR CASE STATEMENT AR VR1,VR0; % POINT TO PLACE IN TABLE % LI VR0,ASCIIQUO; % LOAD HASH % REMOVE ME IF IT WORKS IF <CLI STATE,RISTATE> THEN LI VR0,CASE8BIT ELSE BEGIN LI VR0,NOQUOQUO; % LOAD HASH DON'T QUOTE REPT CHAR STC VR0,0(VR1); % QUOTE FOR HASH IN TABLE AI VR1,X'80'; % POINT TO HIGH ORDER COMPLEMENT LI VR0,NOQUOQU8; END; STC VR0,0(VR1); END ELSE BEGIN IF <MCLC DATA,=C'BINARY',6> THEN BEGIN ERRORCON 'Your PC Kermit does not support 8 bit quote'_ ' binary transfer impossible'; CCALL ERRPACK,A; MVI STATE,SESTATE; % ABORT STATE END; ZR VR0; IC VR0,BINQC; % LOAD LITERAL FOR CASE STATEMENT AR VR1,VR0; % POINT TO PLACE IN TABLE MVI 0(VR1),0; % QUOTE FOR HASH IN TABLE AI VR1,X'80'; % POINT TO HIGH ORDER MVI 0(VR1),ASCI8BIT; END; % OF NO REPT CHARACTER END; % OF DSECT ZR VRF; % SET RETURN CODE USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SFILE'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SFILE % FUNCTION : Sends the File Header packet % changes states on ack or nack % INPUT: none % % % OUTPUT : state = either 'D' send data || 'F' same || 'E' error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SFILE: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; BUMPRTRY XRA; % Increment retry counter IF <MCLC NUMTRY,RETRY,4; CC NL> THEN % Retry exceeded MVI STATE,SESTATE % Send abort state ELSE FDSNBLCK: DO BEGIN % Send end of file block CCALL KFILENAM,A,VR1=DSNAME,VR0=LH:DSNLEN,VRF=DSNAMEX; % LEGAL DSN LH VR0,PUTLEN; MZC PUTLEN,2; LA VR1,PDATA; ST VR1,PUTADD; MZC PUTLEN; % INIT FOR NEXT ROUTINE CCALL SENDDATA,A,VR1=DSNAMEX; SPSPACK AF,SEQNUM,PUTLEN,VR0; % FILE PACKET SPACK CCALL SPACK,A; CCALL RPACK,A; EXIT IF <RNZ VRF> | <TF STOPF>; % Leave if Timeout or Bad BCC ZR XRA; % clear for the case MTRT RTYPE,COMMAND,1; % Scan command type DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK; NCASE: BEGIN % Got a nack LH XRA,RPSEQ; % Load received sequence number IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1; % see if nack for pack+1 STH XRA,RPSEQ; % STORE IN CASE NACK FOR SEQ+1 IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>; % Ok yack case next END; % of nack YCASE: BEGIN % ACK EXIT IF ^<MCLC SEQNUM,RPSEQ,2>; % Wrong packet number ZERORTRY; % % Zero retry counter BUMPSEQ VR0; % Increment packet counter MZC PUTLEN,2; % ZERO OUT PUT LENGTH LA XRA,PDATA; ST XRA,PUTADD; % RESTORE PUT POINTER MZC OTHERLEN,2; % ZERO EOR MZC EDLENACT,4; % ZERO LENGTH OF RECEIVED DATA CCALL FILLDPCK,A; IF <RZ VRF> THEN BEGIN IF <CLI STATE,SFSTATE> THEN MVI STATE,SDSTATE; % ELSE OTHER STATE END ELSE MVI STATE,SZSTATE; % SEND DATA STATE END; % OF ACK ECASE: BEGIN % Error abort MVI STATE,RESTATE; % RECEIVED ABORT END; ENDCASE ELSE BEGIN ERRORCON 'Illegal packet type received '; CCALL ERRPACK,A; % PUT IN BUFFERS MVI STATE,SESTATE; % ABORT END; END; % OK RETRY END; % of FDSNBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'KFILENAM'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : KFILENAM % FUNCTION : Formats data set name for the kermit standard % for the F packet on a send (download) % INPUT: none % % % OUTPUT : updata packet pointer and length %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KFILENAM: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LR XRC,VRF; % PLACE TO STORE FILENAME LH VRF,DSNLEN; % LENGTH OF DSNAME LA VR0,DOT; % LOOK FOR 1ST DOT IN DATA SET NAME LA VR1,DSNAME; LH XRA,DSNLEN; % LENGTH AR VR1,VRF; % POINT TO LAST LCR VRF,VRF; % COUNT BACKWARDS FOR THE FIRST DOT LI XRB,2; FOR XRB DO BEGIN % LOOP UNTIL LAST DOT CCALL FINDCHAR,A; %% IF ZERO EXIT IF <RP VRF> THEN BEGIN SR XRA,VRF; % MINUS BEGINNING NAME SR VR1,VRF; % POINT 1 AFTER DOT LR VRF,XRA; % RESTORE LENGTH FOR NEXT LOOK LCR VRF,VRF; % INDICATE COUNT BACKWARDS END; % OF ANOTHER DOT END; % NO MORE DOTS AI XRA,2; % LENGTH PLUS DOT LH XRB,DSNLEN; % LENGTH LA VR1,DSNAME; AR VR1,XRA; % PONIT AFTER DOT SR XRB,XRA; % GET LENGTH L XRA,ETOAVCON; IF <CI XRB,12; CC H> THEN LI XRB,12; % MAXIMUM LENGTH OF DSNAME EXI XRB,MMVC,0(XRC),0(VR1),0,INCR=YES,DECR=YES; EXI XRB,MTR,0(XRC),0(XRA),*-*,DECR=YES,INCR=YES; % TRANSLATE ETOA STH XRB,PUTLEN; % LENGTH OF DATA USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SDATA'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SDATA % FUNCTION : Sends data packet calls filldpck build packets % % INPUT: none % % % OUTPUT : state = either 'D' more data || 'Z' EOF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SDATA: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; BUMPRTRY XRA; % Increment retry counter IF <MCLC NUMTRY,RETRY,4; CC NL> THEN % Retry exceeded MVI STATE,SESTATE % Send abort state ELSE DO BEGIN % Send data block SPSPACK AD,SEQNUM,PUTLEN,VR0; % D PACKET,SEND PARAMETERS FOR SPACK CCALL SPACK,A; CCALL RPACK,A; EXIT IF <RNZ VRF> | <TF STOPF>; % Leave if Timeout or Bad BCC ZR XRA; % clear for the case MTRT RTYPE,COMMAND,1; % Scan command type DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK; NCASE: BEGIN % Got a nack LH XRA,RPSEQ; % Load received sequence number IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1; % see if nack for pack+1 STH XRA,RPSEQ; % STORE IN CASE NACK FOR SEQ+1 IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>; % Ok yack case next END; % of nack YCASE: BEGIN % ACK EXIT IF ^<MCLC SEQNUM,RPSEQ,2>; % Wrong packet number ZERORTRY; % % Zero retry counter BUMPSEQ VR0; % Increment packet counter MZC PUTLEN,2; % ZERO OUT PUT LENGTH LA XRA,PDATA; ST XRA,PUTADD; % RESTORE PUT POINTER IF <MCLC RECLEN,=H'1',2> THEN BEGIN IF <CLI RDATA,AX> | <CLI RDATA,AZ> THEN BEGIN IF <CLI RDATA,AX> THEN SF ACKX; IF <CLI RDATA,AZ> THEN SF ACKZ; MVI STATE,SZSTATE; EXIT; END; END; CCALL FILLDPCK,A; IF <RZ VRF> THEN MVI STATE,SDSTATE % More data ELSE MVI STATE,SZSTATE; % End of file END; % OF ACK ECASE: BEGIN % Error abort MVI STATE,RESTATE; % RECEIVED ABORT END; ENDCASE ELSE BEGIN ERRORCON 'Illegal packet type received '; CCALL ERRPACK,A; % PUT IN BUFFERS MVI STATE,SESTATE; % ABORT END; END; % OK RETRY END; % of SDATABLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'FILLDPCK'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : FILLDPCK % FUNCTION : FILLS A SEND PACKET WITH DATA FROM KERIN % CALLS KGETREC & PUT BUFF WHEN NEEDED SEND FUNCTIONS % INPUT: NONE % % % OUTPUT : VRF=0 SUCCESSFUL, VRF=KERIN EOF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% FILLDPCK: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; ZR VRF; FDPBLCK: FOREVER DO BEGIN % LOOP UNTIL PACKET FULL OR EOF IF ^<MCLC OTHERLEN,ZERO,2> THEN BEGIN % WE HAVE TO PUT CRLF CCALL PUTBUFF,A,VR1=LFCR,VR0=LFCRLEN; % PUT IT IN MZC OTHERLEN,2; % ZERO OUT END; % OF OTHER LENGTH IF <MCLC EDLENACT,ZERO,4> THEN BEGIN IF <TF KINEOF> THEN BEGIN % EOF ALREADY OCCURED IF ^<MCLC PUTLEN,ZERO,2> THEN ZR VRF % EOF BUT STUFF TO PUT ELSE LI VRF,KERINEOF; EXIT FROM FDPBLCK; END; CCALL GETAREC,A; % READS A RECORD IF <RNZ VRF> THEN BEGIN % EOF OR ERROR IF <CI VRF,KERINEOF> THEN BEGIN % ALL DONE SF KINEOF; % INDICATE EOF IF ^<MCLC PUTLEN,ZERO,2> THEN ZR VRF; % EOF BUT STUFF STILL TO PUT END % OF EOF RETURN ELSE MVI STATE,SESTATE; % OTHER ERROR ABORT EXIT FROM FDPBLCK; END; END; % READ A RECORD IF <TF TABF> THEN BEGIN % IF TABBING PUT IN CCALL PUTTABS,A; % IF TABBING PUT IN END; % OF TABBING % EOF FOR TEXT FILES L VR0,EDLENACT; % LENGTH L VR1,EDPNTR; % POINT TO PLACE IN RECORD TO PUT ZR VRF; IF ^<MCLC EDLENACT,ZERO,4> THEN CCALL SENDDATA,A; IF <RZ VRF> THEN BEGIN MZC EDLENACT,4; % ZERO OUT COUNTER IF <MCLC DATA,=C'TEXT',4> THEN BEGIN % PUT EOF EXIT FROM FDPBLCK IF <TF KINEOF>; % CRLF ALREADY IN BUFFER IF <MCLC OTHERLEN,ZERO,2> THEN BEGIN % WE NEED EOF MMVC OTHERLEN,=H'2',2; CCALL CHECKLEN,A,VR0=4; % SEE IF BUFFFER BIG ENOUGH IF <RNZ VRF> THEN <ZR VRF; EXIT FROM FDPBLCK>; END ELSE MZC OTHERLEN,2; % JUST DID CRLF END; % OF TEXT END % OF ALL DATA PUT ELSE BEGIN % UPDATE POINTERS L XRA,EDPNTR; % POINTER TO DATA L XRB,EDLENACT; % LENGTH OF DATA AR XRA,XRB; % POINT TO LAST CHARACTER PLUS ONE SR XRA,VRF; % POINT TO REMAINING CHARACTERS ST XRA,EDPNTR; ST VRF,EDLENACT; % UPDATA LENGTH AND POINTERS ZR VRF; % INDICATE OK EXIT FROM FDPBLCK; END; END; % OF FDPBLCK IF ^<CI VRF,KERINEOF> THEN ZR VRF; % NON EOF USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; KERINEOF: EQU 4; SUBTITLE 'GETAREC'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : GETAREC % FUNCTION : READS A RECORD FROM DATA SET KERIN FOR % DOWNLOADING USING EDIT ROUTINE % INPUT: NONE % % OUTPUT: VRF=0 GOOD RECORD VRF=KERINEOF - END OF FILE % VRF=READERR - SOME OTHER FATAL ERROR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% GETAREC: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; CALL EDGETL,(EDCNTRL,EDRETURN,EDLINENO,EDPNTR,EDLENACT); IF ^<MCLC EDRETURN,ZERO,4> THEN BEGIN % FILE READ FAIL IF <MCLC EDRETURN,ONE> THEN LI VRF,KERINEOF % END OF FILE ELSE BEGIN % FILE READ ERRORS CALL EDMSG,(EDCNTRL,EDRETURN,EDLINE,EDLMAX2,EDLENACT); L VR0,EDLENACT; IF <CI VR0,90; CC H> THEN LI VR0,90; % SET UP LENGTH CCALL ERRPACK,A,VR1=EDLINE; LI VRF,KERINERR; % ERROR MVI STATE,SESTATE; % ABORT IT END; END % OF ERROR IN READING ELSE BEGIN % OK READ - TRANSLATE TO ASCII FOR KERIN STANDARDS L VR0,EDLENACT; % LENGTH OF DATA LR XRB,VR0; % FOR EXECUTE IF <RP XRB> THEN BEGIN L XRE,EDPNTR; % SET UP POINTER TO GET BUF IF <MCLC DATA,=C'TEXT',4> THEN BEGIN LR XRA,XRB; L XRC,ETOAVCON; DO BEGIN % LOOP UNTIL NO MORE IF <CI XRA,255; CC H> THEN <LI XRB,255; SI XRA,255> ELSE <LR XRB,XRA; ZR XRA>; CCALL CHKETOA,A,VR1=(XRE),VR0=(XRB); % SEE IF UNTRANSLATABLE CHARS EXI XRB,TR,0(*-*,XRE),0(XRC),DECR=YES,INCR=YES; AI XRE,255; END UNTIL <RZ XRA>; % LOOP ALONG END; % TEXT END; % A POSITIVE AMOUNT OF DATA ZR VRF; % INDICATE A GOOD READ END; % OF GOOD READ USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; KERINERR: EQU 8; % READ ERROR SUBTITLE 'SEOF'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SEOF % FUNCTION : Sends the end-of-file packet % changes states on ack or nack % INPUT: none % % % OUTPUT : state = either 'z' eof || 'f' new file || 'B' EOT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SEOF: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; BUMPRTRY XRA; % Increment retry counter IF <MCLC NUMTRY,RETRY,4; CC NL> THEN % Retry exceeded MVI STATE,SESTATE % Send abort state ELSE SEOFBLCK: DO BEGIN % Send end of file block SPSPACK AZ,SEQNUM,ZERO,VR0; % Z PACKET,SEND PARAMETERS FOR SPACK SELECT FIRST; <TF ACKX>: <LA XRA,PDATA; MVI 0(XRA),AD; MMVC PUTLEN,=H'1',2; ZF ACKX>; <TF ACKZ>: <LA XRA,PDATA; MVI 0(XRA),AD; MMVC PUTLEN,=H'1',2>; ENDSEL; CCALL SPACK,A; CCALL RPACK,A; EXIT IF <RNZ VRF> | <TF STOPF>; % Leave if Timeout or Bad BCC ZR XRA; % clear for the case MTRT RTYPE,COMMAND,1; % Scan command type DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK; NCASE: BEGIN % Got a nack LH XRA,RPSEQ; % Load received sequence number IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1; % see if nack for pack+1 STH XRA,RPSEQ; % STORE IN CASE NACK FOR SEQ+1 IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>; % Ok yack case next END; % of nack YCASE: BEGIN % ACK EXIT IF ^<MCLC SEQNUM,RPSEQ,2>; % Wrong packet number ZERORTRY; % % Zero retry counter BUMPSEQ VR0; % Increment packet counter CCALL CLOSESDS,A; % Close input file IF <TF ASTERISK> & ^<TF ACKZ> THEN BEGIN % Wild card or multiple send CCALL NEXTFILE,A; IF ^<CI VRF,ENDCAT> THEN BEGIN CCALL OPENSDSN,A; % Open next sendfile IF ^<TF SENDDSNF> THEN BEGIN ERRORCON 'Can not next file for down load'; CCALL ERRPACK,A; END % OF OPEN ERROR ELSE <MVI STATE,SFSTATE; EXIT>; % SUCCESSFUL FILE OPEN END; END; % of wildcard MVI STATE,SBSTATE; END; % OF ACK ECASE: BEGIN % Error abort MVI STATE,RESTATE; % RECEIVED ABORT END; ENDCASE ELSE BEGIN ERRORCON 'Illegal packet type received '; CCALL ERRPACK,A; % PUT IN BUFFERS MVI STATE,SESTATE; % ABORT END; END; % OK RETRY END; % of SEOFBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SEOT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SEOT % FUNCTION : Sends the end-of-transmission packet % changes states on ack or nack % INPUT: none % % % OUTPUT : state = either 'C' complete || 'B' EOT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SEOT: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; BUMPRTRY XRA; % Increment retry counter IF <MCLC NUMTRY,RETRY,4; CC NL> THEN % Retry exceeded MVI STATE,SESTATE % Send abort state ELSE SEOTBLCK: DO BEGIN % Send end of transmisision block SPSPACK AB,SEQNUM,ZERO,VR0; % B PACKET,SEND PARAMETERS FOR SPACK SELECT FIRST; <TF WARNINGF>: <L XRA,RECPNTR; MVI 0(XRA),AX; MMVC PUTLEN,=H'1',2>; ENDSEL; CCALL SPACK,A; CCALL RPACK,A; EXIT IF <RNZ VRF> | <TF STOPF>; % Leave if Timeout or Bad BCC ZR XRA; % clear for the case MTRT RTYPE,COMMAND,1; % Scan command type DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK; NCASE: BEGIN % Got a nack LH XRA,RPSEQ; % Load received sequence number IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1; % see if nack for pack+1 STH XRA,RPSEQ; % STORE IN CASE NACK FOR SEQ+1 IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>; % Ok yack case next END; % of nack YCASE: BEGIN % ACK EXIT IF ^<MCLC SEQNUM,RPSEQ,2>; % Wrong packet number ZERORTRY; % % Zero retry counter BUMPSEQ VR0; % Increment packet counter MVI STATE,CSTATE; % COMLETE STATE END; % OF ACK ECASE: BEGIN % Error abort MVI STATE,RESTATE; % RECEIVED ABORT END; ENDCASE ELSE BEGIN ERRORCON 'Illegal packet type received '; CCALL ERRPACK,A; % PUT IN BUFFERS MVI STATE,SESTATE; % SEND ABORT STATE END; END; % OK RETRY END; % of SEOTBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; ASCIIREG: EQU 0; % EQUATES FOR TABLE ASCIIQUO: EQU 4; % QUOTE CHARACTER ASCIQUO8: EQU 8; % " + BIT 8 ON ASCI8BIT: EQU 12; % BIT 8 ON REPTQUO: EQU 16; % REPTCHARACTER NOQUOQUO: EQU 20; NOQUOQU8: EQU 24; % ASCII OFFSETS INTO TABLE YOFF: EQU X'59'; NOFF: EQU X'4E'; FOFF: EQU X'46'; DOFF: EQU X'44'; ZOFF: EQU X'5A'; COFF: EQU X'43'; BOFF: EQU X'42'; EOFF: EQU X'45'; AOFF: EQU X'41'; R2OFF: EQU X'52'; % ASCII I SERVER GET COMM IOFF: EQU X'49'; % ASCII I SERVER GET COMM GOFF: EQU X'47'; %ASCII G; ROFF: EQU SCOMLIT; % ASCII COMMAND LITERALS YCOMLIT: EQU X'59'; NCOMLIT: EQU X'4E'; FCOMLIT: EQU X'46'; DCOMLIT: EQU X'44'; ZCOMLIT: EQU X'5A'; CCOMLIT: EQU X'43'; BCOMLIT: EQU X'42'; ECOMLIT: EQU X'45'; ACOMLIT: EQU X'45'; %ACOMLIT: EQU X'41'; SCOMLIT: EQU X'53'; % EQUATES FOR A CASE STATEMENT INDEAL1 FOR PACKET TYPE YCASE: EQU 8; % ACK T PACKET NCASE: EQU 4; % NACK PACKET ECASE: EQU 12; % ERROR PACKET FCASE: EQU 32; % FILE INIT PACKET DCASE: EQU 16; % DATA PACKET ZCASE: EQU 20; % EOF PACKET CCASE: EQU 24; % COMPLETEPACKET BCASE: EQU 28; % EOT PACKET ACASE: EQU 36; % ABORT PACKET SCASE: EQU 40; % SENDINIT PACKET R2CASE: EQU 44; % SERVER GET PACKET GCASE: EQU 48; % SERVER GENERIC COMMMAND PACKET ICASE: EQU 52; % SERVER I PACKET % VARIOUS KERMIT SEND STATES SFSTATE: EQU 12; % SEND FILE INIT PACKET SDSTATE: EQU 16; % SEND % DATA PACKET SZSTATE: EQU 20; % SEND EOF PACKET CSTATE: EQU 24; % COMPLETEPACKET SBSTATE: EQU 28; % SEND EOT PACKET ASTATE: EQU 36; % ABORT PACKET SESTATE: EQU 36; % SEND ABORT PACKET RESTATE: EQU 44; % RECEIVED ABORT PACKET SISTATE: EQU 40; % SENDINIT PACKET % VARIOUS KERMIT RECEIVE STATES RFSTATE: EQU 12; % RECEIVE FILE HEADER PACKET RDSTATE: EQU 16; % RECEIVE % DATA PACKET RZSTATE: EQU 20; % RECEIVE EOF PACKET RBSTATE: EQU 28; % RECEIVE EOT PACKET RISTATE: EQU 56; % RECEIVE INIT PACKET RSTATE: EQU 40; % RECEIVE PACKET R2STATE: EQU 44; % GET PACKET FOR SERVER MODE GSTATE: EQU 48; % GENERIC SERVER COMMANDS ISTATE: EQU 52; % I PACKET SEND: EQU 60; % IN SEND COMMAND MODE RECEIVE: EQU 64; % IN RECEIVE COMMAND MODE SUBTITLE 'SENDDATA'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD NAME : SENDDATA % FUNCTION: BREAK RECORDS INTO PACKET - CALLED BY KSEND % INPUT : VR1-> DATA STRING % VR0=LENGTH OF STRING TO SEND IN PACKETS % OUTPUT: A PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SENDDATA: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LR XRB,VR0; % LENGTH OF DATA LR XRE,VR1; % POINTER TO BEGINNING OF THE STRING SDATABLK: UNTIL <RNP XRB> DO BEGIN IF <TF REPTF> THEN BEGIN LR VR1,XRE; ZR XRA; % FOR TRT TEST CCALL CNTXCHAR,A,VR0=(VR1),VRF=(XRB); % CHECK FOR MATCHES MTRT 0(VR1),REPTABLE,1; IF <CR XRA,VRF; CC L> THEN BEGIN % IF ENUFF WORTH QUOTING BEGIN IF <CI VRF,94; CC H> THEN LI VRF,94; % NINE FOUR HIGHEST KERMIT NUMBER ZR XRA; MTRT 0(VR1),SENDTBL,1; % WHAT TYPE OF CHARACTER CASE XRA MAX 24 MIN 0 CHECK; % CHECK IF BUFFER LARGE ENOUGH 0: LI VR0,3; 4,20,ASCI8BIT: LI VR0,4; ASCIQUO8,24: LI VR0,5; ENDCASE; LR XRC,VRF; % SAVE LENGTH OF MATCHES IN CASE NEEDED CCALL CHECKLEN,A; EXIT FROM SDATABLK IF <RNZ VRF>; % NO MORE ROOM IN PACKET LR VRF,XRC; % RESTORE LENGTH OF CHARACTERS TO QUOTE MMVC 0(VR1),REPTCHAR,1; CHAR VRF; % MAKE IT A KERMIT INTEGER STC VRF,1(VR1); % PUT IN THE COUNT UNCHAR VRF; CCALL PUTBUFF,A,VR0=2; % PUT THE TWO IN SI VRF,1; % DECREMENT COUNT % BIT KLUDGE SR XRB,VRF; AR XRE,VRF; % MOVE POINTER; END; END; % OF REPEAT ZR XRA; MTRT 0(XRE),SENDTBL,1; % SCAN FOR CERTAIN CHARACTER CASE XRA MAX 24 MIN 0 CHECK; 0: BEGIN % MOVE EM ALL CCALL CHECKLEN,A,VR0=1; % SET ANY ROOM LEFT EXIT FROM SDATABLK IF <RNZ VRF>; % NO MORE ROOM IN PACKET END; % OF ALL MOVE ASCIIQUO: BEGIN LI VR0,2; CCALL CHECKLEN,A; EXIT FROM SDATABLK IF <RNZ VRF>; % NO MORE ROOM IN PACKET LI VR0,1; % ONE CHARACTER PUT CCALL PUTBUFF,A,VR1=QUOCHAR; % PUT IN THE CONTROL QUOTE CHARACTER CNTLLOC 0(XRE); % MACRO FOR CONTROL CHARACTERS END; ASCIQUO8: BEGIN LI VR0,3; % THREE CHARACTERS NON SPLIT CCALL CHECKLEN,A; EXIT FROM SDATABLK IF <RNZ VRF>; % NO MORE ROOM IN PACKET LI VR0,1; % ONE CHARACTER PUT CCALL PUTBUFF,A,VR1=BINQC; % PUT IN THE BINARY QUOTE CHARACTER CCALL PUTBUFF,A,VR1=QUOCHAR; % PUT IN THE CONTROL QUOTE CHARACTER CNTLLOC 0(XRE); % MACRO FOR CONTROL CHARACTERS ZAP8BIT 0(XRE); % MACRO FOR ZERO HIGH ORDER END; % 2 QUOTE BITS ASCI8BIT: BEGIN % HIGH ORDER BIT ON LI VR0,2; CCALL CHECKLEN,A; EXIT FROM SDATABLK IF <RNZ VRF>; % NO MORE ROOM IN PACKET LI VR0,1; % ONE CHARACTER PUT CCALL PUTBUFF,A,VR1=BINQC; % PUT IN THE BINARY QUOTE CHARACTER ZAP8BIT 0(XRE); % KILL HIGH ORDER BIT END; REPTQUO: BEGIN WRTERM 'REPT CASE DONT BELONG LUCY'; ZR XRA; % FOR CASE % REGISTER 1 POINTS TO REPT CHAR LA XRD,2(,VR1); % POINT TO CHARACTER MTRT 0(XRD),SENDTBL,1; % TEST ONE CHARACTER CASE XRA MAX 24 MIN 0 CHECK; 0: BEGIN % NO OTHER QUOTING NECESSARY LI VR0,3; END; % OF NO OTHER QUOTE NECESSARY 4,16 : BEGIN % NEED ONE LI VR0,4; CNTLLOC 0(XRD); % MACRO FOR CONTROL CHARACTERS END; % END OF QUOTE CASE 8: BEGIN % NEED ONE ASCII + HIGH ORDER BIT ON LI VR0,5; CNTLLOC 0(XRD); % MACRO FOR CONTROL CHARACTERS ZAP8BIT 0(XRD); % MACRO FOR ZERO HIGH ORDER END; % END OF HIGH BIT& QUOTE CASE 12 : BEGIN % NEED ONE LI VR0,4; ZAP8BIT 0(XRD); % MACRO FOR ZERO HIGH ORDER END; % END OF QUOTE CASE 20: BEGIN % A QUOTE CHARACTER THAT NOTHING SHOULD BE DONE TO LI VR0,4; LI XRA,ASCIIQUO; % SINGLE QUOTE IT END; 24: BEGIN % SAME AS ABOVE BUT IT'S HIGH ORDER COUNTER PART LI VR0,5; ZAP8BIT 0(XRD); % ZAP HIGH ORDER LI XRA,ASCIQUO8; % FAKE OUT NEXT SECTION END; ENDCASE; CCALL CHECKLEN,A; % MUST ALL BE ONE UNIT EXIT FROM SDATABLK IF <RNZ VRF>; % NO MORE ROOM IN PACKET LR VR1,XRD; SI VR1,2; % BACK UP LI VR0,2; % PUT IN REPEAT AND COUNT CCALL PUTBUFF,A; % DO IT LI VR0,1; CASE XRA MAX REPTQUO MIN 0 CHECK; 0: ; % DO NOTHING FALL OUT ASCIIQUO: BEGIN CCALL PUTBUFF,A,VR1=QUOCHAR; END; ASCIQUO8: BEGIN CCALL PUTBUFF,A,VR1=BINQC; % THE BINARY QUOTE CHARACTER CCALL PUTBUFF,A,VR1=QUOCHAR; END; ASCI8BIT: BEGIN CCALL PUTBUFF,A,VR1=BINQC; % THE BINARY QUOTE CHARACTER % THE HIGH ORDER BIT IS ON END; REPTQUO: ; % JUST DROP THROUGH ENDCASE; % LR VR1,XRD; % POINT TO THE CHARACTER CCALL PUTBUFF,A; % PUT IT IN THE OUTPUT BUFFER SI VR1,1; % BACK UP TO LENGTH ZR XRD; IC XRD,0(VR1); UNCHAR XRD; % MAKE IT AN INTEGER AR XRE,XRD; % INCREMENT COUNTER SR XRB,XRD; % DECRENT LENGTH END; % OF REPT CASE 20: BEGIN % A QUOTE CHARACTER LI VR0,2; CCALL CHECKLEN,A; EXIT FROM SDATABLK IF <RNZ VRF>; % NO MORE ROOM IN PACKET LI VR0,1; CCALL PUTBUFF,A,VR1=QUOCHAR; END; 24: BEGIN % A HIGH ORDER QUOTE CHARACTER LI VR0,3; CCALL CHECKLEN,A; EXIT FROM SDATABLK IF <RNZ VRF>; % NO MORE ROOM IN PACKET LI VR0,1; CCALL PUTBUFF,A,VR1=BINQC; CCALL PUTBUFF,A,VR1=QUOCHAR; ZAP8BIT 0(XRE); END; ENDCASE; CCALL PUTBUFF,A,VR1=(XRE),VR0=1; % PUT IT IN THE BUFFER AI XRE,1; % POINT TO NEXT CHARACTER SI XRB,1; % DECREMENT THE LENGTH REGISTER END; LR VRF,XRB; % REMAINING CHARACTERS USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'PUTTABS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : PUTTABS % FUNCTION : PUTS TABS INTO RECORD % CALLED BY FILLDPCK; % INPUT: NONE % OUTPUT : THE RECORD BUFFER WITH TAB CHARACTERS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % PUTTABS: CENTER VRE,HIGHR,ENTRY=NO; MZC TABCNT,2; % ZERO TAB COUNTER ZF TABFOUND; % ZERO FLAG ZR XRD; % ACCUMULATOR L VR0,EDPNTR; % ADDRESS OF POINTER L XRE,EDLENACT; % LENGTH OF DATA RECEIVED L XRA,TABTBLAD; % POINTER TO ARRAY OF TABS MMVC LASTTAB,=H'1'; % INTIALIZE LAST TAB ST VR0,LASTADDR; % LAST ADDRESS OF MOVE TABBLCK: UNTIL <MCLC 0(XRA),=H'0',2> % UNTIL NO MORE TABS DO BEGIN % L VR1,EDPNTR; % POINTER TO RECORD BUFFER LH XRB,0(,XRA); % LOAD TAB CHARACTER SI XRB,1; % ONE LESS FOR COMPARE EXIT FROM TABBLCK IF <C XRB,EDLENACT; CC H>; % EXIT IF TOO LONG AI XRB,1; % RESTORE TAB CHARACTER AR VR1,XRB; % POINT AT TAB PLACE SI VR1,2; % BACK UP IN STRING AT LEAST TWO CHARACTS FOR WORTH WHILE LR VRF,XRB; % SET UP LENGTH TO SCAN SH VRF,LASTTAB; % " STH XRB,LASTTAB; % PUT LR XRB,VRF; % LENGTH OF STRING LCR VRF,VRF; % LOAD COMP TO MAKE ROUTINE COUNT BACKWARD CCALL CNTXCHAR,A,VR0=ASCBLANK; IF <CI VRF,2; CC NL> THEN BEGIN % FOUND TWO BLANKS SF TABFOUND; LR XRE,VRF; % STORE OFF NUMBER OF BLANKS SR XRB,VRF; % UNTABBED ONES L VR0,LASTADDR; % LAST ADDRESS IN NON TAB BUFFER L VR1,TABADDR; % ADDRESS OF TAB BUFFER AH VR1,TABCNT; % NEXT PLACE TO BE L VRF,EDPNTR; AH VRF,0(XRA); % POINT TO END OF CHAIN SI VRF,1; % KNOCK OFF ONE REGARDLESS SR VRF,XRE; % SUB OFF NUMBER OF BLANKS S VRF,LASTADDR; % SUB OFF FOR TOTAL TO MOVE CCALL MVCXCHAR,A; % MOVE UNTABBED ONES AR VR1,VRF; % POINT TO NEXT ENTRY MMVC 0(VR1),TABCHAR,1; % PUT IN TAB CHARACTER AH VRF,TABCNT; AI VRF,1; % ONE FOR THE TAB CHARACTER COMING UP STH VRF,TABCNT; % INCREMENT TAB COUNTER L VR0,EDPNTR; AH VR0,0(XRA); % ADD TAB SI VR0,1; % FOR CORRECT ADDRESS ST VR0,LASTADDR; % PLACE TO MOVE FROM END; % OF BLANKS AI XRA,2; % MOVE POINTER TO NEXT IN TAB TABLE END; % OF TABBLCK IF <TF TABFOUND> THEN BEGIN L VRF,EDLENACT; L VR0,LASTADDR; S VR0,EDPNTR; % NUMBER ALREADY IN BUFFER SR VRF,VR0; % REMAINDER TO PUT IF <RP VRF> THEN BEGIN % A POSITIVE REMAINDER L VR1,TABADDR; % TAB BUFFER AH VR1,TABCNT; % COUNT IN BUFFER L VR0,LASTADDR; % FROM ADDRESS CCALL MVCXCHAR,A; % MOVE THE CHARACTERS LEFT END; % OF POSITIVE NUMBER AH VRF,TABCNT; ST VRF,EDLENACT; MMVC EDPNTR,TABADDR,4; % REINIT ADDRESS END; % OF FOUND A TAB TABEXIT: CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'REPTCNT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : REPTCNT % FUNCTION: SCANS BUFFER FOR LIKE CHARACTERS PUT IN REPTCHAR % PLUS LENGTH, PLUS CHAR % ON RETURN R15 - EQUALS LENGTH OF STRING % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% REPTCNT: ; CENTER VRE,HIGHR,ENTRY=NO; LR XRB,VR0; % LENGTH OF STRING REPTBLCK: DO BEGIN % BLOCK TO DROP OUT OF WHILE <CI XRB,2; CC NL> DO BEGIN % LOOP LOOKS THROUGH STRING DO BEGIN EXIT FROM REPTBLCK IF <CI XRB,2; CC L>; ZR XRA; % ZERO CASE STATEMENT LR VR0,VR1; % POINT TO SAME PLACE FOR CHECK % CASE TO PUT IN REPEAT CHARACTER MTRT 0(VR1),REPTABLE,1; % NUMBER NEEDED FOR WORTHWHILE QUOTING LR VRF,XRB; % LOAD UP NUMBER OF CHARACTERS CCALL CNTXCHAR,A; % COUNT NUMBER OF MATCHES LR XRC,VR1; % POINTER AR XRC,VRF; % POINTER TO NEXT POSITION AI VR1,1; % INCREMENT POINTER SI XRB,1; % SUBTRACT COUNTER END UNTIL <CR VRF,XRA; CC NL>; % LOOP TILL WE FIND OK ONE SI VR1,1; % POINT BACK SR XRB,VRF; % SUBTRACT THE NUMBER EFFECTED AI XRB,1; % ADD IN ONE THAT WE SUBBED OFF ABOVE LR XRA,VRF; % GET LENGTH DO BEGIN % % 94 MAXIMUM NUMBER OF CHARACTERS IF <CI XRA,94; CC H> THEN BEGIN % TOO LARGE LI VRF,94; % MAX VALUE ACCORDING TO KERMIT STANDARDS SI XRA,94; END % OF>94 ELSE BEGIN LR VRF,XRA; % LENGTH ZR XRA; % INDICATE NO MORE END; MMVC 0(VR1),REPTCHAR,1; CHAR VRF; % MAKE THE INTEGER A CHARACTER STC VRF,1(VR1); % STORE OFF LENGTH % THE CHARACTER IS ALREADY IN STRING SO WE JUST LEAVE IT % UNCHAR VRF; % MAKE INTEGER AGAIN AR VR1,VRF; % INCREMENT POINTER TO NEXT REPT PLACE END UNTIL <RNP XRA>; % LOOP THRU WHILE> 94 LR VR1,XRC; % RESTORE POINTER END; % OF WHILE END; % OF REPTBLCK REPTEXIT: CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SCANDSN'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: SCANDSN % FUNCTION: SCANS A STRING TO SET UP DATA SET NAME % INPUT: VR1-> POINTER TO STRING % VR0 = LENGTH OF STRING % OUTPUT: DSNAME VARIABLE FILLED IN % MEMBER NAME FILLED (IF PDS) % RETURN: VRF=0 - GOOD RETURN WITH DSNAME FILLED IN % 4 - " " " " & MEMBER " " + PDS % 8 " " + A WILD CARD -"*" % 12 - VR0=0 ON ENTRY % 16 - ERROR ON DS NAME %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SCANDSN: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; SCERROR NEW=SCDSNERR; ZF PDSF; % ASSUME NOT A PDS ZR VRF; MFC DSNAME,44; DEBLANK VR1,VR0,XRA,ZERO=NO; % DEBLANK STRING MFC DSMEMBER,8; % ZERO MEMBER NAME IF ^<<CLI STATE,SEND> | <CLI STATE,RECEIVE>> | %NOTHING <TF SERVERF> % ALWAYS PASS THROUGH FOR SERVER THEN BEGIN %%% CHECK NOW FOR REPEAT AND STRANGE CHARACTERS MMVC MAXWRITE,=X'7FFF',2; % MAXVALUE MZC BUFCNT,2; % ZERO OUT BUFFER COUNTER MMVC ADDBUF,BUFADCON,4; % ADDRESS OF BUFFER MMVC TEMP,DATA,7; MMVC DATA,=C'BINARY',7; LR XRA,VR0; L XRC,ETOAVCON; EXI XRA,MTR,0(VR1),0(XRC),*-*,INCR=YES,DECR=YES; CCALL KGETBUFF,A; MMVC DATA,TEMP,7; LH VR0,BUFCNT; % NUMBER OF CHARACTERS L VR1,ADDBUF; % ADDRESS OF BEGINNING OF STRING L XRC,ATOEVCON; LR XRA,VR0; EXI XRA,MTR,0(VR1),0(XRC),*-*,INCR=YES,DECR=YES; % ST VR1,DSNADD ; % STH VR0,DSNLEN ; END; SCANDSBK: DO BEGIN % BLOCK TO FALL OUT OF IF NECESSARY STH VR0,TEMP; % STORE OFF LENGTH LR XRA,VR0; % LENGTH IN REGISTER LR XRB,VR1; % POINTER TO STRING CCALL SCANASRK,A; % ROUTINE LOOKS FOR ASTERISK IF <TF ASTERISK> THEN BEGIN IF <<CLI STATE,RFSTATE> | <CLI STATE,RECEIVE>> %NO WILDCARD RECEIVE THEN BEGIN LI VRF,8; % WILDCARD EXIT FROM SCANDSBK; END; CCALL CATLOOK,A; % LOOK INTO CATALOG IF <RZ VRF> THEN CCALL NEXTFILE,A; % SEE IF ENTRY EXISTS IN CATALOG EXIT FROM SCANDSBK; END; % OF * BLOCK LA XRC,DSNAME; IF ^<TF PREFXQUO> THEN BEGIN L XRB,USERPREA; % POINTER TO USER PREFIX LH XRA,USERPREL; % LENGTH OF PREFIX EXI XRA,MMVC,0(XRC),0(XRB),*-*,INCR=YES,DECR=YES; AR XRC,XRA; MVI 0(XRC),C'.'; % PUT IN THE DOT AI XRC,1; % MOVE POINTER TO DATA SET NAME END; IF <MCLC PREFIXL,=H'0',2; CC H> THEN BEGIN LH XRB,PREFIXL; EXI XRB,MMVC,0(XRC),PREFIX,*-*,INCR=YES,DECR=YES; AR XRC,XRB; END; SCINIT (VR1),(VR0); SCANDSN1: DO BEGIN SCAN *; SCKW ,QDSN,QS; % IF QUOTED DATA SET NAME SCKW ,UNQDSN; % REGULAR DSN UNQDSN: % MTRT TEST FOR ILLEGAL CHARACTERS IN DATA SET NAME IF <TF PREFPDSF> THEN BEGIN SCBACK; GOTO UNQMEM; % A PDS PREFIX FILL IN THE MEMBER END; % OF PREFIX PDS LR XRB,VR0; % LENGTH EXI XRB,MMVC,0(XRC),0(VR1),*-*,INCR=YES,DECR=YES; % SAVE DATA SET NAME) BEGIN SCAN *; SCKW ,UNQMEM,PS; % SEE IF MEMBER EXISTS FOR PDS SCKW ,*,B; % ALL DONE BABY UNQMEM: DEBLANK VR1,VR0; %MTRT TEST FOR VALID DSN AGAIN SCPUSH; SCINIT (VR1),(VR0); SCAN; IF <CI VR0,8; CC H> THEN LI VR0,8; LR XRA,VR0; % LENGTH FOR EXECUTE IF <RZ XRA> THEN BEGIN % NOTHING FOR MEMBER IF ^<TF SERVERF> THEN WRTERM 'Member name excedes 8 characters' ELSE BEGIN ERRORCON 'No member name specified'; CCALL ERRPACK,A; MVI STATE,ASTATE; END; % OF NON SERVER LI VRF,BADDSN; % ERROR ON NAME EXIT; % SPLIT THE BLOCK END; % OF ERROR BLOCK EXI XRA,MMVC,DSMEMBER,0(VR1),*-*,INCR=YES,DECR=YES; LA VR0,DOT; % LOOK FOR DOTS LI VRF,8; % MEMBER NAME LENGTH CCALL FINDCHAR,A,VR1=DSMEMBER; IF <RNZ VRF> THEN BEGIN SI VRF,1; AR VR1,VRF; SI VRF,8; LCR VRF,VRF; LA VR0,BLANKS; % MOVE IN BLANKS CCALL MVCXCHAR,A; END; % OF FIXING MEMBER NAME SCDONE; % ERROR IF MORE JUNK ON LINE SF PDSF; % INDICATE WE HAVE A PDS SCPOP; SCANEND; END; EXIT; QDSN: SCPUSH; SCINIT (VR1),(VR0); % SAME THING AS FOR UNQUOTED NAME MFC DSNAME,44; % BLANK IT MFC DSMEMBER,8; LA XRC,DSNAME; % FOR THE PUT % GOTO SCANDSN1; % A BIT KLUDGEY FOR NOW SCAN; % MTRT TEST FOR ILLEGAL CHARACTERS IN DATA SET NAME LR XRB,VR0; % LENGTH EXI XRB,MMVC,0(XRC),0(VR1),*-*,INCR=YES,DECR=YES; % SAVE DATA SET NAME) SCAN *; SCKW ,UNQMEM,PS; % SEE IF MEMBER EXISTS FOR PDS SCKW ,*,B; % ALL DONE BABY SCDONE; SCPOP; EXIT; SCANEND; SCANEND; END; DATA BEGIN % NOTHING SPECIFIED IF ^<TF SERVERF> THEN WRTERM 'nothing specified for data set name' ELSE BEGIN ERRORCON 'Nothing specified for data set name to send'; CCALL ERRPACK,A; MVI STATE,ASTATE; END; END; % OF THEN END; % OF SCANDSBK GLOBAL BLOCK IF <RZ VRF> THEN BEGIN ST VRF,TEMP; % STORE RETURN CODE LA VR1,DSNAME; % NOW WE FIND LENGTH OF DATA SET AI VR1,43; % POINT TO END LI VRF,44; % NUMBER OF CHARACTERS IN DATA SET NAME LCR VRF,VRF; % INDICATE COUNT BACKWARDS LA VR0,BLANKS; % LOOK FOR NON BLANKS CCALL CNTXCHAR,A; LI VR1,44; SR VR1,VRF; % LENGTH OF DATA SET NAME STH VR1,DSNLEN; % STORE OFF LENGTH FIELD CCALL VALIDDSN,A,VR1=DSNAME,VR0=LH:DSNLEN,VRF=DSMEMBER; % L VRF,TEMP; % RESTORE COMP CODE END; DATA BEGIN SCDSNERR: LI VRF,BADDSN; END; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF SCDSNEND: CEXIT VRE,HIGHR; LTORG; EXORG; BADDSN: EQU 16; PDSDSN: EQU 8; CATFILE: EQU 4; % FILE RETURN FROM CATALOG GOODDSN: EQU 0; SUBTITLE 'VALIDDSN'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : VALIDDSN % FUNCTION : CHECKS A STRING FOR A VALID 370/VS DSNAME % % INPUT: VR0-> LENGTH OF DSNAME % VR1-> POINTER TO DATASET NAME % VRF = POINTER TO MEMBER NAME IF PDS % OUTPUT : REG VRF =0 GOOD DSNAME ELSE BAD DATA SET NAME %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% VALIDDSN: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LR XRB,VR1; % POINTER TO DSNAME LR XRC,VR0; % LENGTH LR XRE,VRF; % MEMBER POINTER ZR XRA; % BLAST REG2 FOR TRT LI VRF,BADDSN; % ASSUME BAD DOSYNTAX: DO BEGIN % BLOCK OF ROUTINE IF <TF PDSF> THEN BEGIN EXIT FROM DOSYNTAX IF <MTRT 0(XRE),MEMTABLE,8; CC NZ>; EXIT FROM DOSYNTAX IF <<CLI 0(XRE),C'A'; CC L> | <CLI 0(XRE),C'Z'; CC H>> & ^<CLI 0(XRE),C'#'> & ^<CLI 0(XRE),C'@'> & ^<CLI 0(XRE),C'$'>; END; % OF PDS EXI XRC,MTRT,0(XRB),DSNTABLE,*-*,INCR=YES,DECR=YES; % CHECK BAD CHAR EXIT FROM DOSYNTAX IF <RNZ XRA>; FOREVER DO BEGIN % CHECK THE REST EXIT FROM DOSYNTAX IF <<CLI 0(XRB),C'A'; CC L> | <CLI 0(XRB),C'Z'; CC H>> & ^<CLI 0(XRB),C'#'> & ^<CLI 0(XRB),C'@'> & ^<CLI 0(XRB),C'$'>; LR VR1,XRC; % SAVE COUNT DO BEGIN EXIT IF <CLI 0(XRB),C'.'>; AI XRB,1; END FOR XRC; EXIT FROM DOSYNTAX IF <SR VR1,XRC; CI VR1,8; CC H>; % ONLY 8 BETWEEN EXIT IF <RNP XRC>; % NO MO AI XRB,1; SI XRC,1; % SKIP OVER . EXIT FROM DOSYNTAX IF <RNP XRC>; END; % OF FOREVER ZR VRF; % INDICATE GOOD RETURN CODE END; % OF MAIN BLOCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; % TABLES FOR LEGAL DATA SET NAME DSNTABLE: DC 256AL1(BADDSN); BEGIN ORG DSNTABLE+C'A'; DC 9X'00'; % A-I ORG DSNTABLE+C'J'; DC 9X'00'; % J-R ORG DSNTABLE+C'S'; DC 8X'00'; % S-Z ORG DSNTABLE+C'@'; DC X'00'; % NATIONAL @ ORG DSNTABLE+C'#'; DC X'00'; % NATIONAL # ORG DSNTABLE+C'$'; DC X'00'; % NATIONAL $ ORG DSNTABLE+C'.'; DC X'00'; % NATIONAL . ORG DSNTABLE+C'-'; DC X'00'; % NATIONAL - ORG DSNTABLE+C'0'; DC 10X'00'; % 0-9 ORG DSNTABLE+X'C0'; DC X'00'; % PLUS ZERO ORG; END; % TABLES FOR LEGAL DATA SET MEMBER NAME MEMTABLE: DC 256AL1(BADDSN); BEGIN ORG MEMTABLE+C'A'; DC 9X'00'; % A-I ORG MEMTABLE+C'J'; DC 9X'00'; % J-R ORG MEMTABLE+C'S'; DC 8X'00'; % S-Z ORG MEMTABLE+C'@'; DC X'00'; % NATIONAL @ ORG MEMTABLE+C' '; DC X'00'; % A BLANK AT THE END ORG MEMTABLE+C'#'; DC X'00'; % NATIONAL # ORG MEMTABLE+C'$'; DC X'00'; % NATIONAL $ ORG MEMTABLE+C'0'; DC 10X'00'; % 0-9 ORG; END; SUBTITLE 'SCANASRK'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE: SCANASRK % FUNCTION : SEARCHES SEND DATASET NAME FOR * FOR WILDCARD SEND % INPUT : VR1->STRING % VR0=LENGTH OF NAME % OUTPUT: FILLED IN SUFFIX OR/AND PREFIX %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SCANASRK: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; ASKBLCK:DO BEGIN % BLOCK TO FALL OUT OF MZC DSNPFL,2; % ZERO LENGTH OF PREFIX MZC DSNSFL,2; % " " " SUFFIX MFC LASTDSN,44; % ZERO OUT OLD ZF FULLQDSN ; % IF <TF PREFXQUO> THEN <MMVC LASTDSN,PREFIX,8> % QUOTED PREFIX ELSE BEGIN % MOVE IN ACCOUNT INITIALS LA XRC,LASTDSN; % POINT AT DATA SET NAME L XRB,USERPREA; % POINTER TO USER PREFIX LH XRA,USERPREL; % LENGTH OF PREFIX EXI XRA,MMVC,0(XRC),0(XRB),*-*,INCR=YES,DECR=YES; AR XRC,XRA; MVI 0(XRC),C'.'; % PUT IN THE DOT END; ZR VRF; % ZERO RETURN CODE % DEBLANK (VR1),(VR0) IF <CI VR0,1> & <CLI 0(VR1),C'*'> THEN SF ASTERISK % SEND ALL ELSE BEGIN % NOT A TOTAL SCAN LR XRE,VR1; % LOAD ADDRESS POINTER LR XRB,VR0; % LOAD FOR EXECUTE ZR XRA; % ZERO FOR CASE EXI XRB,MTRT,0(XRE),ASTRKTBL,*-*,INCR=YES,DECR=YES; CASE XRA MAX 4 MIN 0 CHECK; 0: <ZF ASTERISK>; % END OF IT NOT A WILDCARD (IE NO *) JUST FALL OUT 4: BEGIN % WE HAVE AN ASTERISK SF ASTERISK; % TURN ON ASTERISK INDICATOR LR XRC,VR1 ; % STORE LOCATION OF ASTERISK % CHECK FOR FULLY QUOTED DATA SET NAME WITH ASTERISK SCPUSH ; SCINIT (XRE),(XRB) ; SCAN * ; SCKW ,FQDSN,QS ; SCKW ,*,B ; FQDSN: SF FULLQDSN ; % FULLY QUOTED DATA SET NAME % SINCE FULLY QUALIFIED RELOAD LR XRE,VR1; % LOAD ADDRESS POINTER LR XRB,VR0; % LOAD FOR EXECUTE ZR XRA; % ZERO FOR CASE EXI XRB,MTRT,0(XRE),ASTRKTBL,*-*,INCR=YES,DECR=YES; LR XRA,VR1 ; SR XRA,XRE ; % NUMBER OF SCANNED CHARACTERS IF ^<CLI 7(XRE),C'.'> | % BETTER BE A DOT <CI XRA,8;CC L> THEN BEGIN % TOO FEW CHARACTERS % FOR FULL QUALIFIED DSN ERRORCON 'Illegal fully quoted data set name with wildcard'; CCALL ERRPACK,A ; IF <TF SERVERF> THEN CCALL SABORT,A,VR0=LH:RPSEQ ELSE TPUT (VR1),(VR0) ; % LI VRF,24 ; EXIT FROM ASKBLCK ; END ELSE BEGIN MFC LASTDSN,44 ; MMVC LASTDSN,0(XRE),8 ; % THIS SETS UP THE CATALOG NAME END ; SCANEND ; % SCPOP ; IF ^<TF FULLQDSN> THEN LR VR1,XRC ; % RESTORE ASTERISK POINTER LR VR0,VR1; SR VR0,XRE; % TOTAL CHARACTERS SCANED IF <RP VR0> THEN BEGIN % STORE OFF BEGINNINGS STH VR0,DSNPFL; % PREFIX LENGTH; LR XRA,VR0; % FOR EXECUTE EXI XRA,MMVC,DSNPFIX,0(XRE),*-*,INCR=YES,DECR=YES; % MOVE IT END; % OF PREFIX SR XRB,VR0; % SUBTRACT TO SEE IF REMAINDER SI XRB,1; % SUBTRACT ONE FOR ASTERISK ITSELF IF <RP XRB> THEN BEGIN % STORE OFF LAST STH XRB,DSNSFL; % SUFFIX LENGTH EXI XRB,MMVC,DSNSFIX,1(VR1),*-*,INCR=YES,DECR=YES; END; % OF SUFFIX END; % OF ASTERISK FOUND ENDCASE ELSE WRTERM 'ERROR IN CASE OF ASTERISK'; END; % OF ELSE NON TOTAL * SEND END ; % OF ASKBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'NEXTFILE'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %MODULE : NEXTFILE %FUNCTION: CALLS TSO CATALOG TO FIND THE NEXT ENTRY AFTER % DSNAME, CHECKS AGAINST PREFIX AND SUFFIX CRITERIA % AND RETURNS MATCH IF EXISTS IN DSNAME ELSE BLOCKS % IT OUT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% NEXTFILE: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; % IF DSNPFL = 45 THEN WE SEND ALL IN CATALOG % L XRC,CATDSPTR; % POINTER TO PLACE IN CATALOG USE XRC AS CATDSET IN BEGIN % DATASET DSECT DO BEGIN % LOOP THROUGH CATALOG SELECT FIRST; <CLI TYPEBYTE,C'A'>: CATBLCK1: DO BEGIN % FOUND SOMETHING % MMVC LASTDSN,RETURNDS,44; % MOVE OVER DSNAME LH XRA,MATCHDSL; % LOAD PREFIX LENGTH IF <RP XRA> THEN BEGIN EXI XRA,MCLC,CATDNAME,MATCHDSN,*-*,DECR=YES,INCR=YES; IF <CC => THEN BEGIN % FOUND A MATCH FOR DATASET NAME IF <MCLC DSNSFL,=H'0',2; CC H> THEN BEGIN % CHECK SUFFIX LA VR0,BLANKS; % POINT TO BLANKS LI VRF,44; % LENGTH OF DSNAME CCALL FINDCHAR,A,VR1=CATDNAME; % FIND FIRST BLANK IF <RZ VRF> THEN LI VRF,44 ELSE SI VRF,1; % LENGTH OF DSN SH VRF,DSNSFL; AR VR1,VRF; % POINTER TO SUFFIX BEGINNING LH VRF,DSNSFL; EXI VRF,MCLC,0(VR1),DSNSFIX,*-*,INCR=YES,DECR=YES; IF ^<CC => THEN BEGIN LI VRF,NOFILE; EXIT FROM CATBLCK1; END; END; % OF SUFFIX MMVC DSNAME,CATDNAME,44; LI VRF,FILEMTCH; LI XRB,44; % INDEX FOR DSNAME LA VR1,DSNAME; AI VR1,43; % POINT TO LAST CHARACTER IN DSNAME UNTIL <CLI 0(VR1),C' '; CC NE> | <RZ XRB> DO BEGIN SI XRB,1; % DECREMENT COUNTER SI VR1,1; END; IF <CLI 0(VR1),C'.'> THEN <MVI 0(VR1),C' '; SI XRB,1>; % NO DOTS LAST STH XRB,DSNLEN; % STORE LENGTH OF DSNAME END ELSE LI VRF,NOFILE; % NO MATCH KEEP SCANNING END; END; % OF FOUND SOMETHING %%%% INVERT DSNAME & PREFIX SCAN BACKWARDS <CLI TYPEBYTE,X'FF'>: BEGIN % END OF CHAIN LI VRF,ENDCAT; % END OF CATALOG NO MORE MATCHES END; % OF 4 CASE ENDSEL ELSE WRTERM 'WRONG BYTE TYPE IN CAT'; AI XRC,45; % INDEX TO NEXT POINT IN CATALOG END UNTIL <CI VRF,FILEMTCH> | <CI VRF,ENDCAT>; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF ST XRC,CATDSPTR; % STORE OFF POINTER FOR NEXT TIME CEXIT VRE,HIGHR; LTORG; EXORG; END; % OF DSECT FOR DSNAME FILEMTCH: EQU 0; NOFILE: EQU 4; % NO FILE FOUND ENDCAT: EQU 20; SUBTITLE 'BLDMATCH'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE: BLDMATCH % FUNCTION: BUILDS A DATASET NAME FOR THE COMPARE FROM CATALOG %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% BLDMATCH: CENTER VRE,HIGHR,ENTRY=NO; MFC MATCHDSN,44; % ZERO OUT ZR XRA; % LENGTH COUNTER LA XRB,MATCHDSN; % POINTER IF ^<TF FULLQDSN> THEN BEGIN % FULLY QUALIFIED WILD CARD IF ^<TF PREFXQUO> THEN BEGIN L XRC,USERPREA; % POINTER TO USER PREFIX LH XRA,USERPREL; % LENGTH OF PREFIX EXI XRA,MMVC,0(XRB),0(XRC),*-*,INCR=YES,DECR=YES; AR XRB,XRA; % % INCREMENT POINTER MVI 0(XRB),C'.'; % PUT IN THE DOT AI XRB,1; AI XRA,1; % INCRMENT POINT AND COUNTERS END; IF <MCLC PREFIXL,=H'0',2; CC H> THEN BEGIN LH XRC,PREFIXL; AR XRA,XRC; % LENGTH EXI XRC,MMVC,0(XRB),PREFIX,*-*,INCR=YES,DECR=YES; AR XRB,XRC; % MOVE POINTER END; END ; % OF NOT FULLY QUALIFIED IF <MCLC DSNPFL,=H'0',2; CC H> THEN BEGIN LH XRC,DSNPFL; AR XRA,XRC; % LENGTH EXI XRC,MMVC,0(XRB),DSNPFIX,*-*,INCR=YES,DECR=YES; AR XRB,XRC; % MOVE POINTER END; STH XRA,MATCHDSL; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'CNTXCHAR'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : CNTXCHAR % FUNCTION : COMPARES A STRING TO A CHARACTER FOR A LENGTH % AND RETURNS IN REG 15 THE NUMBER OF MATCHES % INPUT: VR0-> THE CHARACTER TO CHECK % VR1-> THE STRING TO CHECK AGAINST % VRF = LENGTH OF VR1 STRING % OUTPUT : REG VRF CONTAINS THE NUMBER OF CHARACTERS THAT MATCH %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CNTXCHAR: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LR XRB,VR0; % LOAD ADDRESS OF CHARACTER TO CHECK AGAINST LR XRA,VRF; % LOAD COUNTER LTR XRA,XRA; IF <CC M> THEN <ZF FORWARDF; LCR XRA,XRA> ELSE SF FORWARDF; % OR BACKWARD IF HIGH ORGER ZR VRF; % ZERO COUNTER FOR XRA DO BEGIN EXIT IF ^<MCLC 0(VR1),0(XRB),1>; % LEAVE LOOP ON NOT EQUAL AI VRF,1; % BUMP ACCUMULATOR IF <TF FORWARDF> THEN AI VR1,1 % INCREMENT POINTER ELSE SI VR1,1; % BACK UP IF NEGATIVE COUNT END; % OF FOR LOOP USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'FINDCHAR'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : FINDCHAR % FUNCTION : FINDS A CHARACTER IN A STRING FOR A LENGTH % AND RETURNS IN REG 15 THE RELATIVE POSITION % INPUT: VR0-> THE CHARACTER TO FIND % VR1-> THE STRING TO CHECK AGAINST % VRF = LENGTH OF VR1 STRING % OUTPUT : REG VRF CONTAINS THE RELATIVE POSITION CHARACTERS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% FINDCHAR: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LR XRB,VR0; % LOAD ADDRESS OF CHARACTER TO CHECK AGAINST LR XRA,VRF; % LOAD COUNTER LTR XRA,XRA; IF <CC M> THEN <ZF FORWARDF; LCR XRA,XRA> ELSE SF FORWARDF; % OR BACKWARD IF HIGH ORGER LR XRC,XRA; % SAVE COUNT AI XRC,1; % ONE MORE LI VRF,1; % ZERO COUNTER FOR XRA DO BEGIN EXIT IF <MCLC 0(VR1),0(XRB),1>; % LEAVE LOOP ON EQUAL AI VRF,1; % BUMP ACCUMULATOR IF <TF FORWARDF> THEN AI VR1,1 % INCREMENT POINTER ELSE SI VR1,1; % BACK UP IF NEGATIVE COUNT END; % OF FOR LOOP IF <CR XRC,VRF> THEN <ZR VRF>; % ZERO IF NOTHING FOUND USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'MFCXCHAR'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : MFCXCHAR % FUNCTION : FILLS A STRING WITH A CHARACTER FOR A LENGTH % INPUT: VR0-> THE FILL CHARACTER % VR1-> THE BUFFER TO FILL % VRF = LENGTH OF VR1 STRING % OUTPUT : THE STRING HAS CHARACTER FILLED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MFCXCHAR: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LR XRB,VR0; % ADDRESS POINTER LR XRA,VRF; % ACCUMLATOR IF > 255 DO BEGIN % LOOP IF > 255 IF <CI XRA,255; CC H> THEN <ZR VRF; LI VRF,255; SI XRA,255> ELSE ZR XRA; IF <RP VRF> THEN BEGIN MMVC 0(VR1),0(XRB),1; % MOVE FIRST CHARACTER SI VRF,1; % DECREMENT ACCUMULATOR IF <RP VRF> THEN EXI VRF,MMVC,1(VR1),0(VR1),*-*,DECR=YES; % MOVE EM END; % OF POSITIVE LOOP END UNTIL <RZ XRA>; % UNTIL ALL DONE CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'MVCXCHAR'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : MVCXCHAR % FUNCTION : MOVES VR0-> TO VR1->FOR A LENGTH % INPUT: VR0-> THE FROM ADDRESS % VR1-> THE BUFFER TO PUT % VRF = LENGTH OF VR1 STRING % OUTPUT : THE STRING HAS CHARACTER FILLED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MVCXCHAR: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LR XRA,VRF; % ACCUMLATOR IF > 255 LR XRB,VR0; % ADDRESS OF FROM DO BEGIN % LOOP IF > 255 IF <CI XRA,255; CC H> THEN <ZR VRF; LI VRF,255; SI XRA,255> ELSE <LR VRF,XRA; ZR XRA>; IF <RP VRF> THEN BEGIN EXI VRF,MMVC,0(VR1),0(XRB),*-*,DECR=YES; % MOVE EM AI XRB,255; % MOVE ADDRESSES AI VR1,255; END; % OF POSITIVE LOOP END UNTIL <RZ XRA>; % UNTIL ALL DONE CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'CATLOOK'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %MODULE : CATLOOK %FUNCTION: CALLS TSO CATALOG TO FIND THE ENTRY LASTDSN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CATLOOK: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; % LA VR1,CIRPARM; % ADDRESS OF PARAMETER BLOCK DO BEGIN % SEARCH THROUGH CATALOG FOR A MATCH UNTIL EOF DS 0H; LINK EP=IKJEHCIR; % ,LSEARCH=NO; % CALL CATALOG ROUTINE LOOKCASE: CASE VRF MAX 12 MIN 0; 0: BEGIN % FOUND SOMETHING % MMVC LASTDSN,RETURNDS,44; % MOVE OVER DSNAME L XRA,CIRWA; % LOAD ADDRESS OF RETURNED CATALOG BUFFER MMVC 2(XRA),=H'0',2; % ZERO OUT LENGTH IN CAT BUFFER AI XRA,4; % INCREMENT PAST COUNT BYTES ST XRA,CATDSPTR; % STORE OFF POINTER TO BUFFER CCALL BLDMATCH,A; % BUILD PREFIX FOR DSNAME END; % OF FOUND SOMETHING %%%% INVERT DSNAME & PREFIX SCAN BACKWARDS 4: BEGIN % LOCATE FAIL IF <CLI CIRLOCRC,X'08'> THEN BEGIN % END OF CHAIN LI VRF,NOFILE; % END OF CATALOG NO MORE MATCHES END; IF <CLI CIRLOCRC,X'08'> THEN BEGIN % END OF CHAIN END; END; % OF 4 CASE 12: BEGIN WRTERM ' VOL BY LOCATE ERROR'; END; ENDCASE; END; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'CHECKLEN'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE NAME -CHECKLEN % % FUNCTION - USED BY KSEND, QUOTED PACKETS CAN'T BE SPLIT % VR0 - NUMBER OF CHARACTER TO PUT - % VRF=0 ON RETURN RETURN IF BUFF % LARGE ENOUGH, ELSE VRF =4 % CHECKLEN: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LH XRA,MAXPUT; % MAX LENGTH OF BUFFER SH XRA,PUTLEN; % GET REMAINDER IF <CR XRA,VR0; CC L> THEN LI VRF,4 % TOO SMALL TO FIT ELSE ZR VRF; % ENOUGH ROOM GO AHEAD AND PUT IT USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SERVER'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SERVER % FUNCTION : SERVER SLAVE MODE ENABLED RECEIVES COMMANDS % INPUT: NONE - WAITS ON PACKETS % % % OUTPUT : NONE - PERFORMS FUNCTIONS TILL L PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SERVER: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; USE XRC AS PACKET IN BEGIN % ADRESSABLE DSECT ZF LOGOUT ; LA XRC,RECPKT; % RECEIVE PACKET ADDRESS WRTERM ' Now entering SERVER mode - type FINISH or LOGOUT on micro'_ ' to halt SERVER'; SERVBLCK: WHILE <TF SERVERF> DO BEGIN % SERVER BLOCK % CALL TIMER SO SERVER CAN TIME OUT USER AFTER SERVWAIT TIME TIME BIN ; % GET TIME IN BINARY A VR0,SERVWAIT ; % BUMP CURRENT TIME BY TIME TO WAIT ST VR0,SERVTIME ; % STORE IT OFF ZF STOPF; % ZERO STOP FLAG BCCTYPE 1; % 1 BCC BYTE AT END L XRA,RTIMEOUT; % SAVE TIMEOUT MMVC RTIMEOUT,SERVTOUT,4; % SERVER TIME OUT DO BEGIN % UNTIL WE GET SOMETHING CCALL RPACK,A; % GET THE PACKET EXIT FROM SERVBLCK IF ^<TF SERVERF>; NEXT OF SERVBLCK IF <TF STOPF>; IF <RNZ VRF> THEN BEGIN % RESPOND TO PACKET MZC OLDSEQ,2; % ZERO OUT SEQUENCE NUMBER MMVC OLDBCC,BCCLEN,2; % STORE OFF OLD BCC MVI BCCLEN+1,1; % TYPE 1 BCC FOR SERVER TIMEOUT SERVNACK XRB; % RESPOND TO PACKET MMVC BCCLEN,OLDBCC,2; % RESTORE BCC LR XRB,VRF ; % STORE OLD VALUE % CHECK TIMER FOR EXTENDED TIME OUT TIME BIN ; LR VRF,XRB ; % RESTORE RPACK VALUE IF <C VR0,SERVTIME ; CC H> THEN BEGIN SF LOGOUT ; % INDICATE TO LOGUSER OFF MMVC TEMP,=C'LOGOFF ',7 ; % CCALL TSOCMD,A,VR1=TEMP,VR0=7 ; % STACK LOGOFF COMMAND ZF SERVERF ; WRTERM 'The SERVER has exceeded its timeout and is logged off'; EXIT FROM SERVBLCK ; END ; END; % OF NACK TIMEOUT END UNTIL <RZ VRF>; % LOOP TILL WE GET A GOOD INPUT ST XRA,RTIMEOUT; % REPLACE THE READ TIME OUT ZR XRA; % ZERO REG FOR CASE STATEMEN5T MTRT RTYPE,SERVCOMM,1; % SERVER COMMAND TYPE CASE XRA MAX ISTATE MIN 0 CHECK; 0 THRU ACASE: BEGIN % THE REST MVI STATE,ASTATE; % ABORT ERRORCON 'Illegal Packet type for SERVER '; CCALL ERRPACK,A; % SET UP FOR ERROR PROCESSING END; % REST CASE RSTATE: BEGIN % WE RECEIVED AN SEND INIT PACKET CCALL KRECEIVE,A,; % CALL RECEIVE ROUTINE; END; % RSTATE CASE R2STATE: BEGIN % WE RECEIVED A GET PACKT IC XRA,RLEN; % LENGTH OF PACKET-2 UNCHAR XRA; % MAKE INTEGER SH XRA,BCCLEN; % TAKE OFF BCCLENGTH SI XRA,2; % SUB OFF TYPE & SEQ BYTE L XRB,ATOEVCON; EXI XRA,TR,RDATA(*-*),0(XRB),DECR=YES,INCR=YES; EXI XRA,TR,RDATA(*-*),UPPER,DECR=YES,INCR=YES; % UPPER % HENCE LEFT WITH DSN LENGTH EXI XRA,MMVC,DSNAMEX,RDATA,0,DECR=YES,INCR=YES; % MOVE THE NAME LR VR0,XRA; % LOAD LENGTH OF DSNAME SCINIT DSNAMEX,(XRA); SCTYPE NEW=1; CCALL KSEND,A,VR1=DSNAMEX; % SET UP END; % GETCASE GSTATE: BEGIN % A SERVER GENERIC COMMAND SELECT FIRST; <CLI RDATA,X'4C'>: BEGIN % LOGOFF COMMAND MMVC TEMP,=C'LOGOFF ',7; LI VR0,7; CCALL TSOCMD,A,VR1=TEMP; % LOGOUT SF LOGOUT ; ZF SERVERF; % GOOD BYE KERMIE ACKIT VR0; END; % OF LOGOFF <CLI RDATA,X'46'>: BEGIN % FINISH SERVER COMMAND ZF SERVERF; % FINISH SERVER COMMAND ACKIT VR0; END; ENDSEL ELSE BEGIN ERRORCON 'Unimplemented SERVER Commmand'; CCALL ERRPACK,A; % SET UP FOR ERROR PROCESSING MVI STATE,SESTATE; % ABORT CCALL SABORT,A,VR0=LH:RPSEQ; % SEND ABOR END; % OF SELECT END; % OF CASE ISTATE: BEGIN % WE RECEIVED AN I PACKET MVI RTYPE,ROFF; % SEND INIT PACKET FOR SUB BCCTYPE 1; % BLOCK CHECK TYPE ZEROSEQ; % ZERO SEQUENCE NUMBER ZERORTRY; % ZERO RETRY MVI STATE,RISTATE; % SEND INIT STATE %UNTIL <CLI STATE,RFSTATE> | <MCLC RETRY,NUMTRY; CC L> | %<CLI STATE,SESTATE> | <CLI STATE,RESTATE> CCALL RINIT,A; % CALL RECEIVE INIT IF <CLI STATE,SESTATE> THEN CCALL SABORT,A,VR0=LH:RPSEQ; % SEND ABOR END; % ISTATE CASE ENDCASE ELSE BEGIN ERRORCON 'Unknown Server packet type'; CCALL ERRPACK,A; % SET UP FOR ERROR PROCESSING MVI STATE,ASTATE; % ABORT MMVC PHDR,RSOH,1; % SOH MMVC PNUM,RSEQ,1; END; % OF ERROR CASE END; % OF SERVER BLOCK LOOP FOREVER UNTIL END PACKET USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF END; % OF ADDRESSIBILITY DSECT % CHECH WHETHER LOGOFF IF ^<TF LOGOUT> THEN BEGIN LI VR0,100; % 1 SECOND FOR TIMER ST VR0,TEMP; STIMER WAIT,BINTVL=TEMP; % WAIT FOR ONE SECOND IN ORDER NOT TO LOSE % THE PROMPT END ; CEXIT VRE,HIGHR; % OUT OF SERVER LTORG; EXORG; SUBTITLE 'KSHOW'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % MODULE NAME - KSHOW % % % FUNCTION- LISTS THE CURRENT ENVIORNMENT OF THE SET COMMAND % % % % INPUTS - NONE EXCEPT POSSIBLE '?' / OR HELP % % % % % OUTPUTS- SCREEN OUTPUT OF CURRENT OPTIONS % % % RETURN % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KSHOW: ; CENTER VRE,HIGHR,ENTRY=NO; SHOWBLCK: DO BEGIN % BLOCK TO FALL THRU SCERROR NEW=SHOWSCAN; % SET UP FOR SCDONE IF MORE TOKENS SCAN *; SCKW (STATUS,STA),SHOWBEG; % UP TOP IF STATUS REQUEST SCKW (?,HELP),SHOWHELP; SCKW ,SHOWSCAN; % NO OTHER PARMS SCANEND; % ERROR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SHOWBEG: % LABEL FOR END %%%%% HEADER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN; % INIT VAREA FOR OUTPUT WRTERM ' '; % BLANK LINE VSEG KERMVA,'Data Set Attributes '; % column 1 title CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'Protocol Attributes'; % column 2 title VOUT KERMVA; % OUTPUT IT %WRTERM ' '; % A BLANK LINE MMVC CRTLINE#,=H'1',2; % INITIAL CRT LINE TO FIRST DO BEGIN % UNTIL CRTLINE# = TOTALCRT SELECT; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,2>: BEGIN % EDIT IF <TF EDITF> THEN VSEG KERMVA,'EDIT (WYLBUR edit format data set): on' ELSE VSEG KERMVA,'EDIT (Non Edit format data set): off'; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,4>: BEGIN % TABS VSEG KERMVA,'TABS: '; IF <TF TABF> THEN VSEG KERMVA,'on' ELSE VSEG KERMVA,'off'; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,3>: BEGIN % Number function VSEG KERMVA,'NUMBERED '; VSEG KERMVA,'(line nos.): '; SELECT FIRST; <MCLC EDTYPE,=F'1',4>: BEGIN VSEG KERMVA,'off'; END; <MCLC EDTYPE,=F'2',4>: VSEG KERMVA,'WYLBUR'; <MCLC EDTYPE,=F'3',4>: VSEG KERMVA,'(numbered in cols): WYLBUR XX/YYY'; <MCLC EDTYPE,=F'4',4>: VSEG KERMVA,'(TSO default numbers): TSO'; <MCLC EDTYPE,=F'5',4>: VSEG KERMVA,'(numbered in cols): TSO COL/COL'; ENDSEL; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,1>: BEGIN % DATA % DATA TEXT OR BINARY VSEG KERMVA,'DATA: '; IF <MCLC DATA,=C'TEXT',4> THEN VSEG KERMVA,'Text' ELSE VSEG KERMVA,'Binary'; END; % OF SELECT BEGIN <CLI CRTLINE#+1,5>: BEGIN % RECFM VSEG KERMVA,'RECFM (Record format): '; IF <CLI RFM,C'U'> THEN VSEG KERMVA,RFM,1 % MOVE IN REC FORMAT ELSE VSEG KERMVA,RFM,2; % MOVE IN REC FORMAT END; % OF SELECT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,6>: BEGIN % LRECL VSEG KERMVA,'LRECL (Logical record length): '; CVBTD TEMP,0,LH:LRECL; % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % LREC IN TO BUFFER END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,7>: BEGIN % BLKSIZE VSEG KERMVA,'BLKSIZE (Block size): '; CVBTD TEMP,0,LH:BLKSIZE; % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % BLKSIZE IN TO BUFFER END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,8>: BEGIN % SPACE VSEG KERMVA,'SPACE (Space allocation): '; CVBTD TEMP,0,L:TRACK; % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % TRACK IN TO BUFFER VSEG KERMVA,' tracks '; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,9>: BEGIN % VOLUME VSEG KERMVA,'VOLUME: '; % DEFAULT DISK IF ANY VSEG KERMVA,VOLUME,7; % DISK DRIVE END; % OF SELECT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,10>: BEGIN % PREFIX VSEG KERMVA,'PREFIX: '; LH VR0,PREFIXL; % CONVERT BINARY TO DEC IF <RZ VR0> THEN VSEG KERMVA,'No prefix' ELSE BEGIN IF <TF PREFXQUO> THEN BEGIN ST VR0,TEMP; % STORE OFF NUMBER OF CHARACTERS VSEG KERMVA,'"'; L VR0,TEMP; % RESTORE LENGTH END; % OF QUOTED PREFIX VSEG KERMVA,PREFIX,(VR0); % PREFIX IN TO BUFFER IF <TF PREFXQUO> THEN VSEG KERMVA,'"'; END; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,5>: BEGIN % QUOTE CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'CQUOTE (Control quote character): '; MVC TEMP(1),QUOCHAR; % MOVE TO WORK AREA L XRA,ATOEVCON; TR TEMP(1),0(XRA); % PUT IN EBCDIC VSEG KERMVA,TEMP,1; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,8>: BEGIN % SOH CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'SOH (Start of Header): '; CVBTD TEMP,0,LOADB:SSOH; % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % SOH CHAR IN TO BUFFER CCALL SHOWASCI,A,VR1=SSOH; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,9>: BEGIN % SEOL CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'SEOL (Send End-of-line): '; CVBTD TEMP,0,LOADB:SEOL; % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % EOL CHAR IN TO BUFFER CCALL SHOWASCI,A,VR1=SEOL; END; % OF SELECT BEGIN <CLI CRTLINE#+1,10>: BEGIN % REOL CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'REOL (Receive End-of-line): '; CVBTD TEMP,0,LOADB:REOL; % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % EOL CHAR IN TO BUFFER CCALL SHOWASCI,A,VR1=REOL; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,6>: BEGIN % BINARY QUOTE CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'BQUOTE (Binary quote character): '; MVC TEMP(1),BINQC; % MOVE TO WORK AREA L XRA,ATOEVCON; TR TEMP(1),0(XRA); % PUT IN EBCDIC VSEG KERMVA,TEMP,1; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,7>: BEGIN % REPEAT QUOTE CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'RQUOTE (Repeat quote character): '; MVC TEMP(1),REPTCHAR; % MOVE TO WORK AREA L XRA,ATOEVCON; TR TEMP(1),0(XRA); % PUT IN EBCDIC VSEG KERMVA,TEMP,1; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,4>: BEGIN % PACKET SIZE CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'PACKET (Receive packet size): '; CVBTD TEMP,0,L:RPSIZ; % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % RECEIVE SIZE INTO BUFFER END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,1>: BEGIN % DELAY CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'DELAY (after SEND): '; L VR1,DELAY; % DELAY TIME ZR VR0; D VR0,=F'100'; LR VRF,VR1; % SET UP FOR MACRO CVBTD TEMP,0,(VRF); % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % DELAY TIME INTO BUFFER VSEG KERMVA,' seconds '; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,11>: BEGIN % DEBUG CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'DEBUG: '; IF <TF DBUGFLAG> THEN VSEG KERMVA,'on' ELSE VSEG KERMVA,'off'; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,2>: BEGIN % TIMER CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'TIMER (Timeout interval): '; IF ^<TF TIMERF> THEN VSEG KERMVA,'off' ELSE BEGIN VSEG KERMVA,'on ('; L VR1,RTIMEOUT; % TIMEOUT TIME TIME ZR VR0; D VR0,=F'100'; LR VRF,VR1; % SET UP FOR MACRO CVBTD TEMP,0,(VRF); % CONVERT BINARY TO DEC VSEG KERMVA,(VR1),(VR0); % DELAY TIME INTO BUFFER VSEG KERMVA,' seconds)'; END; % OF TIMER FLAG END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <CLI CRTLINE#+1,3>: BEGIN % BLOCK CHECK TYPE CCALL ALIGN,A; % ADJUSTS THE COLUMNS TO 40 VSEG KERMVA,'BLOCK (Block check type): '; SELECT FIRST; <CLI HIGHBCC,1>: VSEG KERMVA,'1'; <CLI HIGHBCC,2>: VSEG KERMVA,'2'; <CLI HIGHBCC,3>: VSEG KERMVA,'3 (CRC)'; ENDSEL; END; % OF SELECT BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ENDSEL; LH XRA,CRTLINE#; AI XRA,1; STH XRA,CRTLINE#; % BUMP IT VOUT KERMVA; % OUTPUT IT END UNTIL <MCLC CRTLINE#,MAXCRC#,2; CC H>; % END OF MAIN LOOP EXIT FROM SHOWBLCK; SHOWSCAN: DO BEGIN % IF REMAINING TOKENS ERROR OR HELP WRTERM 'Valid options are SHOW STATUS or HELP'; EXIT FROM SHOWBLCK; % FALL OUT SHOWHELP: WRTERM 'The SHOW command lists the current option settings.'; WRTERM 'The options may be changed with the SET command.'; END; % OF SCDONE END; % OF SHOWBLCK %VSEG KERMVA,')'; %WRTERM ' '; % BLANK CEXIT VRE,HIGHR; SAVESHOW: DC 18F'0'; % SAVE AREA %TEMP: DC CL15; % A WORK BUFFER ALREADY DEFINED OUTLEN: EQU 80; % OUTPUT LINE LENGTH LTORG; EXORG; SUBTITLE 'SHOWASCI'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE SHOWASCI % FUNCTION - VSEGS THE ASCII AKCRONYM FOR ITS BINARY CONTER PART % INPUT - VR1 -> 1 BYTE HEX %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SHOWASCI: CENTER VRE,HIGHR,ENTRY=NO; LR XRB,VR1; ZR XRA; IC XRA,0(VR1); % LOAD THE CHARACTER VSEG KERMVA,' ('; LA VR1,ASCILITS; % POINT TO BEGINNING OF TABLE MH XRA,=H'3'; % INDEX INTO TABLE AR VR1,XRA; % " IF <CLI 2(VR1),C' '> THEN VSEG KERMVA,(VR1),2 % PUT INTO VSEG ELSE VSEG KERMVA,(VR1),3; % PUT INTO VSEG VSEG KERMVA,','; LR VR1,XRB; % RESTORE POINTER TO BYTE FOR NEXT SUB CCALL SHOWCNTL,A; % PUTS VALUE IN CONTROL NOTATION (EG ^A=X'01') VSEG KERMVA,')'; CEXIT VRE,HIGHR; LTORG; SUBTITLE 'SHOWCNTL'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE SHOWCNTL % FUNCTION - VSEGS THE ASCII CONTROL FOR ITS BINARY CONTER PART % INPUT - VR1 -> 1 BYTE HEX %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SHOWCNTL: CENTER VRE,HIGHR,ENTRY=NO; ZR XRA; IC XRA,0(VR1); % LOAD THE CHARACTER %VSEG KERMVA,' ('; LA VR1,ASCCNTLC; % POINT TO BEGINNING OF TABLE MH XRA,=H'2'; % INDEX INTO TABLE AR VR1,XRA; % " VSEG KERMVA,(VR1),2; % PUT INTO VSEG %ELSE VSEG KERMVA,(VR1),3; % PUT INTO VSEG %VSEG KERMVA,')'; CEXIT VRE,HIGHR; LTORG; SUBTITLE 'KERMVOUT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % OUT PUT ROUTINE FOR VSEG %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KERMVOUT: CENTER VRE,HIGHR,ENTRY=NO; TPUT (VR1),(VR0),R; % OUTPUT IT CEXIT VRE,HIGHR; SUBTITLE 'ADSTATUS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: ADSTATUS % FUNCTION : LINKS AN ENTRY INTO STATUS MESSAGE CHAIN % INPUT : VR1-> BUFFER % VR0= L'BUFFER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ADSTATUS: CENTER VRE,HIGHR,ENTRY=NO; LR XRA,VR0; EXI XRA,MMVC,STATBUFF,0(VR1),*-*,INCR=YES,DECR=YES; STH VR0,STATLEN; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'GETTABS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE- GETTABS % FUNCTION - COUNT THE NUMBER OF SPACES TO NEXT TAB PLACE % INPUTS - NONE % OUTPUT - VRF= NUMBER OF SPACES/BLANKS TO PUT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% GETTABS: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; ZR VRF; % ZERO RETURN LH XRA,BUFCNT; % NUMBER OF CHARACTERS ALREADY IN OUT BUFFER L VR1,TABTBLAD; % TABLE OF TAB CHARACTERS GETTABLK: UNTIL <MCLC 0(VR1),ZERO,2> DO BEGIN % TAB BLOCK IF <CH XRA,0(,VR1); CC L> THEN BEGIN % COUNT LESS THAN TAB LH VRF,0(,VR1); % LOAD THE TAB POINTER FROM CHAIN SR VRF,XRA; % SUBTRACT BUFCNT SI VRF,1; % ONE EXTRA FOR GOOD MEASURE EXIT FROM GETTABLK IF <RP VRF>; % LEAVE IF POSITIVE END; % OF FOUND THE TAB ENTRY AI VR1,2; % INCREMENT POINTER TO NEXT TAB ITEM END; % OUT OF TABTABLE USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'ALIGN '; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % ALIGNS TO 40 COLUMNS THE BUFFER IN VSEG IN SET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ALIGN: CENTER VRE,HIGHR,ENTRY=NO; VTELL KERMVA; % VR1 => KERMVA VR0=LENGTH ZR XRA; LI XRA,40; SR XRA,VR0; IF <RP XRA> THEN BEGIN VSEG KERMVA,BLANKS,LA:0(,XRA); % PUT BLANKS IN END; CEXIT VRE,HIGHR; LTORG; SUBTITLE 'TSOCMD'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD NAME - TSOCMD % % FUNCTION - USE TSO SERVICE COMMAND TO PASS A TSO % STRING TO TSO % % INPUTS - VR1 = ADDRESS OF STRING % VR0 = LENGTH OF STRING % RETURN - VR15 = 0 IF OK ELSE ADDRESS OF PARM4 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TSOCMD: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LR XRA,VR0; % LOAD REG FOR EXECUTE MOVE ST VR0,PARM3; % STORE OFF LENGTH FIELD EXI XRA,MMVC,PARM2,0(VR1),*-*,DECR=YES,INCR=YES; % THIS STATEMENT MOVES DATA TO PARM FIELD BAL; L 15,TSOADD LOAD ROUTINE ADDRESS CALL (15),(PARM1,PARM2,PARM3,PARM4,PARM5,PARM6),VL ALP; IF <RZ VRF> THEN BEGIN LA VRF,PARM4; END; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'KRPACK'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: RPACK % FUNCTION : GETS A PACKET OF DATA FROM REMOTE KERMIT % VIA ROUTINE KERMTGET - TIMEOUT ROUTINE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RPACK: % RECEIVE PACKET FROM MICRO CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LA XRC,RECPKT; USE XRC AS PACKET IN BEGIN % ADDRESSIBLE DSECT RPACKBLK: DO BEGIN ZR VRF; % GOOD RETURN CODE IF <TF TESTF> THEN BEGIN % READ FROM FILE GET TESTFILE; ST VR1,TGETBUFA; % STORE OFF ADDRESS MZC TGETLEN,4; % KLUDGE TO THE MOON MMVC TGETLEN+2,0(VR1),2; % KLUDGE TO THE MOON %MTR 0(VR1),ETOA,130; % KLUDGE CITY FOR READING TEST FILES ZR VRF; GOTO JUMPOVER; END; IF <TF TIMERF> | <TF SERVERF> THEN BEGIN % ALWAYS NEED TIMER SERVER % SET TIMER STIMER REAL,TIMEEXIT,BINTVL=RTIMEOUT; END; IF <TF RTURNRND> THEN STIMER WAIT,BINTVL=RTURNTIM; % TURNAROUND POST ECBREAD,ECBTREAD; % TELL ASYNC SUB TO GO FOR IT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TESTECB: WAIT ECB=ECBTGET; MVI ECBTGET,0; % ZERO HIGH ORDER IF <CLI ECBTGET+3,ECBTREAD> THEN BEGIN % TGET READ POSTED IF <TF TIMERF> THEN TTIMER CANCEL; ZR VRF; % ZERO RETURN REGISTER END ELSE BEGIN IF <CLI ECBTGET+3,ECBTIMER> THEN BEGIN % TIMER-ECB POSTED DETACH TASKADD; % BLOW OFF TASK MZC ECBREAD,4; % ZERO OUT READ ECB L XRB,TGETADD; % ADDRESS OF TGET MODULE IDENTIFY EP=KERMTGET,ENTRY=(XRB); IF <RNZ VRF> THEN BEGIN % ERROR IN IDENTIFY IF ^<CI VRF,4> THEN BEGIN TPUT =C'ERROR IN IDENTIFY',17; DC F'0'; % BLOWUP END; END; DELETE EP=KERMTGET ; % THEN REATTACH ATTACH EP=KERMTGET,PARAM=((XRF)); IF <RNZ VRF> THEN BEGIN END; ST VR1,TASKADD; % STORE OFF ADDRESS FOR DETACH LI VRF,TIMERROR; % TIME OUT LITERAL FOR RETURN CODE EXIT FROM RPACKBLK; % GET OUT END ELSE BEGIN ERRORCON 'UNKNOWN POST VALUE ECB'; CCALL ERRPACK,A; % PUT IN ERROR BUFFER MVI TYPE,ACOMLIT; % ABORT LITERAL EXIT FROM RPACKBLK; END; END; JUMPOVER: ; % LABEL TO SKIP TO L XRA,TGETBUFA; IF <<MCLC 0(XRA),=C'stop',4> | <MCLC 0(XRA),=C'STOP',4>> THEN BEGIN % GET OUT user wants to stop KLUDGCIT: IF <TF TIMERF> THEN TTIMER CANCEL; SF STOPF; % STOP ERRORCON 'User entered STOP. Transfer aborted.'; CCALL ERRPACK,A; LI VRF,STOPFLAG; % FOR RETURN CODE EXIT FROM RPACKBLK; END; IF <TF SERVERF> THEN BEGIN % VIOLATE KERMIT HEURISTICS HERE BECAUSE THEY SAY TO IF <<MCLC 0(XRA),=C'finish',6> | % GET OUT IF SERVER <MCLC 0(XRA),=C'FINISH',6>> THEN BEGIN % GET OUT IF SERVER ZF SERVERF; % TURN OFF SERVER ZR VRF; % FOR RETURN CODE EXIT FROM RPACKBLK; % GET OUT IF SERVER END; END; % OF SERVER FUNCTIONS IF <MCLC 0(XRA),=C'ABORT',5> THEN DC XL4'00000000'; L VR1,TGETLEN; % LENGTH OF STUFF GOTTEN IF <RNP VR1> THEN BEGIN LI VRF,TGETERR; % ERROR FROM TGET EXIT FROM RPACKBLK; END; % OF TGET ERROR FOR VR1 DO BEGIN % LOOP THROUGH LENGTH LOOKING FOR SOH EXIT IF <MCLC (XRA),RSOH,1>; % FOUND SOH AI XRA,1; % INCREMENT POINTER IF <CI VR1,1> THEN BEGIN ERRORCON 'No SOH on packet'; LI VRF,NOSOH; EXIT FROM RPACKBLK; END; END; % OF FOR LOOP MMVC RECPKT,0(XRA),130; % MOVE TO RECPACKET IF <RNZ VRF> THEN BEGIN ERRORCON 'Error in Tget from Micro '; CCALL ERRPACK,A; % PUT IN ERROR BUFFER MVI TYPE,ACOMLIT; % ABORT LITERAL EXIT FROM RPACKBLK; END; % OF ERROR OF TPUT L XRB,ETOAVCON; MTR LEN,0(XRB),1; % TRANSLATE TO ASCII ZR XRB; IC XRB,LEN; % GET LENGTH OF PACKET UNCHAR XRB; % MAKE PRINTABLE L VR1,ATOEVCON; MTR LEN,0(VR1),1; % TRANSLATE TO ASCII LH XRA,BCCLEN; AI XRA,2; % MINIMAL PACKET SIZE IF <CR XRB,XRA; CC L> | % ERROR PACKET TOO SMALL <C XRB,MAXPACK; CC H> THEN BEGIN % TOO LARGE L VRF,LENERROR; EXIT FROM RPACKBLK; END; % OF LENGTH ERROR ON RECEIVE IF <OPENP DEBUG> THEN BEGIN % DEBUGGING ON MZC WRKBUFF,4; % BLAST 1ST 4 BYTES MVI WRKBUFF+1,19; MMVC WRKBUFF+4,=C'TGET REC PACKET',15; PUT DEBUG,WRKBUFF; AI XRB,2; % BUMP LENGTH COUNTER TO INCLUDE HEADER EXI XRB,MVC,WRKBUFF+4(*-*),PACKET,DECR=YES,INCR=YES; AI XRB,4; % FOR HEADER STH XRB,WRKBUFF; SI XRB,6; % ADJUST LENGTH BACK TO ORIGINAL PUT DEBUG,WRKBUFF; % OUTPUT AGAIN END; % OF DEBUG BLOCK AI XRB,2; % BUMP LENGTH COUNTER L VR1,ETOAVCON; EXI XRB,TR,PACKET(*-*),0(VR1),DECR=YES,INCR=YES; % CHANGE TO ASCII SI XRB,1; % RESTORE COUNTER % SUBTRACT 1,2, OR 3 DUE TO BCC TYPE SH XRB,BCCLEN; LR VR0,XRB; % GET LENGTH FIELD CCALL BCCCALC,A,VR1=LEN; % BCC COMPUTATION SUB EXIT FROM RPACKBLK IF <C VRF,=X'FFFFFFFF'>; % SOMETHING FUNNY ZR VRF; % OK RETURN WE HOPE LA XRE,PACKET+1(XRB); % CHECK THIS LATER LH VR1,BCCLEN; SI VR1,1; % DECRMENT FOR EXECUTE\ % %CHAR VRF; % ASCII PRINTABLE IF ^<EX VR1,CLMCOMP> THEN BEGIN % ERROR IN BCC CHECK % WRTERM ' BCC ERRROR CHECK IN RPACK '; LI VRF,BCCERROR; EXIT FROM RPACKBLK; END; % OF BCC ERROR CCALL UNPACK,A,VR1=PACKET; END; % OF RPACKBLK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; CLMCOMP: MCLC 0(XRE),BCC,*-*; END; % OF DSECT PACKET TIMERROR: EQU 4; % EQUATE FOR TIME OUT RETURN BCCERROR: EQU 8; % INCORRECT BCC NOSOH: EQU 12; STOPFLAG: EQU 16; % INDICATE A STOP TGETERR: EQU 20; % ERROR FROM TGET ROUTINE DS 0F; SUBTITLE 'UNPACK'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : UNPACK % FUNCTION : TAKE A RECEIVE PACKET AND DECODES THE % PACKET LENGTH, SEQ NUMBER, AND DOES % INPUT: VR1-> SOH OF PACKET % % % OUTPUT : SEQ MVC TO RSEQ,L'RDATA STH IN RECLEN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% UNPACK: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; USE XRA AS PACKET IN BEGIN LR XRA,VR1; % POINT TO PACKET ZR XRB; IC XRB,SEQ; % GET RECEIVE SEQ UNCHAR XRB; % MAKE IT AN INTEGER; STH XRB,RPSEQ; % STORE OFF RECEIVED SEQ NUMBER ZR XRB; IC XRB,LEN; % GET LENGTH TO CALCULATE DATA UNCHAR XRB; SI XRB,2; % SUB SEQ AND TYPE BYTES SH XRB,BCCLEN; % SUB OFF BLOCK CHECK LENGTH STH XRB,RECLEN; LA XRB,DATABUFF; ST XRB,RECPNTR; % POINTER TO RECEIVED DATA END; % OF DSECT USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'TIMEEXIT'; TIMEEXIT: BALR BASER,0; USING *,BASER; % ADDRESSIBLITY L XRF,PARMACON; POST ECBTGET,ECBTIMER; % POST TIMER ECB RGOTO 14; % RETURN TO OS PARMACON: DC A(PARMS); % WORKING STORAGE SUBTITLE 'PUT BUFFER '; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % THIS ROUTINE PLACES INFO INTO OUTPUT BUFFER % CALLED BY KSEND % VR1-> GET BUFFER % VR0 = LENGTH OF GET BUFFER % ROUTINE PUTS ALL INTO BUFFER AND CALLS SPACK % WHEN NECESSARY % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PUTBUFF: CENTER VRE,HIGHR,ENTRY=NO; ST VR1,GETADD; % ADDRESS OF GET STH VR0,GETLEN; % LENGTH OF GETS PUTBLCK: L VR1,GETADD; L XRB,PUTADD; LH XRA,MAXPUT; % GET DIFFERENCE SH XRA,PUTLEN; % NUMBER OF CHARACTERS IN PUT BUFF LH XRD,GETLEN; % LENGTH OF IN PUT EXI XRD,MVC,0(*-*,XRB),0(VR1),DECR=YES,INCR=YES; AR XRB,XRD; % UPDATE PUT ADDRESS ST XRB,PUTADD; % STORE OFF NEW OUT ADDRESS LH XRA,PUTLEN; AR XRA,XRD; % UPDATE LENGTH STH XRA,PUTLEN; ZR VR0; % NO MORE CHARACTERS TO PUT DROP OUT MZC GETLEN,2; % ZERO GET LENGTH CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'KRECEIVE'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % MODULE NAME - KRECEIVE % % % FUNCTION- DRIVER FOR REC COMMAND DYNAL, OPEN, % FORMATS PACKETS, FILE HEADER, EOF ETC % % % INPUTS - % % % % % OUTPUTS- % % % RETURN % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KRECEIVE: ; CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LA XRC,SNDPKT; USE XRC AS PACKET IN BEGIN % DSECT FOR INIT LA XRD,DATABUFF; USE XRD AS SENDIDST IN BEGIN RECBLCK: DO BEGIN % GLOBAL REC BLOCK MVI STATE,RECEIVE; MZC STATLEN,2; % ZERO OUT STATUS LENGTH ZF WARNINGF; % NO WARNINGS YET MFC DSNAME,44; % CLEAR OUT DATA SET NAME BCCTYPE 1; % 1 BCC BYTE AT END IF <TF SERVERF> THEN <MZC DSNLEN,2; GOTO RGETINIT>; % SERVER STUFF SCERROR NEW=RECERR; % SCAN OFF DSN SCAN *; SCKW ?,RECHELP; % INFO SCKW ,REC1ST,B,LIMIT=AL1(44); % DSN SCANEND; % IF HERE NO DSNAME MZC DSNLEN,2; % ZERO DATA SET NAME GOTO RGETINIT; % A GOTO I ADMIT EXIT FROM RECBLCK; % LEAVE REC RECHELP: WRTERM 'RECEIVE receives a data set (file) from the microcomputer.'; WRTERM 'A corresponding SEND command must '_ 'be issued to the microcomputer'; WRTERM 'KERMIT after the RECEIVE is issued to TSO KERMIT.'; WRTERM 'The parameter is the data set name '_ 'to be used for the received data set.'; WRTERM 'If the parameter is omitted, the file name from the sender '_ 'is used as'; WRTERM 'the data set name.'; EXIT FROM RECBLCK; % LEAVE REC RECERR: SELECT FIRST; <CI VRF,SCTCLXM>: WRTERM 'Data Set Name maximum 44 letters '; ENDSEL ELSE <WRTERM 'ERROR IN SCANNER IN REC MOD '>; EXIT FROM RECBLCK; % ERROR EXIT REC1ST: % THE BEEF % STORE OFF POINTERS IN CASE MORE FILES % SCBACK; % BACK UP IN CASE A PDS MEMBER EXISTS SCTELL; DEBLANK VR1,VR0,XRA,TYPE=BOTH; % STRIP OFF BLANKS ST VR1,DSNADD; % ADDRESS OF DSNAME STH VR0,DSNLEN; % LENGTH OF SCANNED NAME LR XRA,VR0; % FOR EXECUTE CCALL CHKRDSN,A; % ROUTINE CHECKS WHEATHER VALID DSN FOR RECEIVE IF <RZ VRF> THEN CCALL OPENRDSN,A; % OPEN THE FILE IF <RZ VRF> THEN BEGIN % GOOD DATA SET RGETINIT: % GET INIT PACKET IF ^<TF SERVERF> THEN WRTERM 'Ready to receive files'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 % CALL REC FILE SWITCH TABLE DRIVER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CCALL RECSW,A; END ELSE BEGIN % COULDN'T OPENDSN IF <TF SERVERF> THEN BEGIN CCALL SABORT,A,LH:VR0=RPSEQ; END ELSE <LH VR0,STATLEN; TPUT STATBUFF,(VR0)>; END; END; % OF RECBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; END; % OF DSECT END; % OF DSECT RECINIT SUBTITLE 'RECUNALLOCATE '; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 % MOD: RECUNAL % FUN: UNALLOCATES DSNAME FOR RECEIVE MOD %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RECUNAL: CENTER VRE,HIGHR,ENTRY=NO; LA XRB,DSNAME; % GET ADDRESS OF DSNAME DALLIST BEGIN,MF=(E,UALLOCD2),INIT=NO; BEGIN DALLIST TEXT,DUNDSNAM,(0(XRB),DSNSIZE); % DSNAME DALLIST TEXT,DUNUNALC,MF=L; % FORCE UNALLOCATION DALLIST END; END; DATA BEGIN % DYNAMIC ALLOCATION PARAMETER LIST FOR % UNALLOCATION BY DSNAME UALLOCD2: DALLIST BEGIN,S99VRBUN,MF=L; BEGIN DALLIST TEXT,DUNDSNAM,(,DSNSIZE); % DSNAME DALLIST TEXT,DUNUNALC; % FORCE UNALLOCATION DALLIST END; END; END; CEXIT VRE,HIGHR; LTORG; SUBTITLE 'RECSW'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : RECSW % FUNCTION : THIS ROUTINE DRIVES THE RECEIVE MODULES, % EACH ROUTINE CHANGES THE STATE % INPUT: % % % OUTPUT : %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RECSW: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; %MVI HIGHBCC,3; % INDICATE BLOCK CHECK TYPE BCCTYPE 1; % BLOCK CHECK TYPE ZEROSEQ; % ZERO SEQUENCE NUMBER ZERORTRY; % ZERO RETRY MVI STATE,RISTATE; % SEND INIT STATE RSWTBLCK: DO BEGIN % LOOP TILL EXIT SELECT FIRST; <TF STOPF>: <CCALL STOPPROC,A; EXIT FROM RSWTBLCK>; % USER STOP <CLI STATE,RISTATE>: CCALL RINIT,A; <CLI STATE,RFSTATE>: CCALL RFILE,A; % FILE HEADER PACKET <CLI STATE,RDSTATE>: CCALL RDATAMOD,A; % GET DATA PACKETS <CLI STATE,SESTATE>: BEGIN % ABORT CCALL SABORT,A,VR0=LH:RPSEQ; EXIT FROM RSWTBLCK; % ABORT END; <CLI STATE,RESTATE>: <CCALL RABORT,A; EXIT FROM RSWTBLCK>; % ABORT <CLI STATE,CSTATE>: EXIT FROM RSWTBLCK; % COMPLETE STATE SPLIT ENDSEL; END FOREVER; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'RFILE'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : RFILE % FUNCTION : Receives the f packet and decodes it % changes states % INPUT: none % % % OUTPUT : state = either 'C' complete || 'B' EOT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RFILE: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; BUMPRTRY XRA; % Increment retry counter IF <MCLC NUMTRY,RETRY,4; CC NL> THEN % Retry exceeded MVI STATE,SESTATE % Send abort state ELSE RFILBLCK: DO BEGIN % Receive file name CCALL RPACK,A; EXIT IF <TF STOPF>; % Leave if user entered stop IF <RNZ VRF> THEN BEGIN % NACK if Timeout or Bad BCC NACKPACK SEQNUM,VR0; % NACK IT EXIT FROM RFILBLCK; END; % OF ERROR ZR XRA; % clear for the case MTRT RTYPE,COMMAND,1; % Scan command type DO BEGIN CASE XRA MAX SCASE MIN ECASE CHECK; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A SENDINIT PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SCASE: BEGIN % SEND INIT PACKET RECEIVED BUMPOTRY VR0; IF <MCLC OLDTRY,RETRY,4; CC NL> % Retry exceeded | ^<MCLC OLDSEQ,RPSEQ,2; CC NL> THEN % MUST BE LAST SEQ MVI STATE,SESTATE % Send abort state ELSE BEGIN % Receive file name CCALL SPAR,A,VR1=PDATA,VR0=LH:RECLEN; % SET PARMS SPSPACK AY,RPSEQ,RECLEN,VR0; CCALL SPACK,A; MZC NUMTRY,L'NUMTRY; % % Zero retry counter END; END; % OF REC INIT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A EOF PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ZCASE: BEGIN % EOF PACKET RECEIVED - CLOSE OUT BUMPOTRY VR0; IF <MCLC OLDTRY,RETRY,4; CC NL> % Retry exceeded | ^<MCLC OLDSEQ,RPSEQ,2; CC NL> THEN % MUST BE LAST SEQ MVI STATE,SESTATE % Send abort state ELSE BEGIN % Receive file name SPSPACK AY,RPSEQ,ZERO,VR0; CCALL SPACK,A; MZC NUMTRY,L'NUMTRY; % % Zero retry counter CCALL CLOSERDS,A; % CLOSE THE DATA SET END; END; % OF REC EOF FOR THE SECOND TIME %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A ERROR PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ECASE: BEGIN % Error abort MVI STATE,RESTATE; % RECEIVED ABORT CCALL ERRPACK,A,VR1=RDATA,VR0=LH:RECLEN; END; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A EOT PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% BCASE: BEGIN % End of transmission IF ^<MCLC SEQNUM,RPSEQ,2> THEN BEGIN % MUST BE THE RIGHT PACKET MVI STATE,SESTATE; % SENDAN ABORT ERRORCON 'Illegal packet sequence for eot in rfile- must abort'; CCALL ERRPACK,A; END % bad sequence number ELSE BEGIN ACKPACK SEQNUM,VR0; % ACK IT MVI STATE,CSTATE; % LA FINE END; END; % OF EOT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A FILE PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% FCASE: BEGIN % f packet with file name - what we want IF ^<MCLC SEQNUM,RPSEQ,2> THEN BEGIN % MUST BE THE RIGHT PACKET MVI STATE,SESTATE; % SENDAN ABORT ERRORCON 'Illegal sequence for f packet in rfile- must abort'; CCALL ERRPACK,A; END % bad sequence number ELSE BEGIN IF <MCLC DSNLEN,ZERO,2> THEN BEGIN % GET NAME FROM PACKET CCALL DSNPACK,A,VR1=RDATA,VR0=LH:RECLEN; % DECODE NAME IF <RZ VRF> THEN CCALL OPENRDSN,A; % OPEN THE NEXT FILE IF <RNZ VRF> THEN MVI STATE,SESTATE ; % ABORT ON BOARD EXIT FROM RFILBLCK IF <RNZ VRF>; % ERROR ON OPEN END; ACKPACK SEQNUM,VR0; % ACK IT MMVC OLDTRY,NUMTRY,4; % KEEP OLD COUNTER ZERORTRY; % A GOOD PACKET BUMPSEQ VR0; % NEXT SEQ NUMBER MZC BUFCNT,2; % ZERO BUFFER COUNTER MZC DSNLEN,2; % ZERO LENGTH OF DSN FOR NEXT ONE L VR1,ADDBUF; % BEGINNING OF BUFFER ST VR1,BUFADD; % POINTER TO PLACE IN BUFFER ZF CRFLAG,QUO8FLAG; MVI STATE,RDSTATE; % CHANGE DATA TO RECEIVE DATA END; % OF GOOD F PACKET END; % OF F PACKET ENDCASE ELSE BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED AN ILLEGAL PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ERRORCON 'Illegal packet type for rfile - transfer aborted'; CCALL ERRPACK,A; % PUT IN BUFFERS MVI STATE,SESTATE; % SEND ABORT STATE END; END; % OK RETRY END; % of RFILBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'RDATAMOD'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : RDATAMOD % FUNCTION : Receives data packet and decodes them % also receives eof % INPUT: none % % % OUTPUT : state = either 'C' complete || 'B' EOT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RDATAMOD: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; BUMPRTRY XRA; % Increment retry counter IF <MCLC NUMTRY,RETRY,4; CC NL> THEN % Retry exceeded MVI STATE,SESTATE % Send abort state ELSE RDATBLCK: DO BEGIN % Receive file name CCALL RPACK,A; EXIT IF <TF STOPF>; % Leave if user entered stop IF <RNZ VRF> THEN BEGIN % NACK if Timeout or Bad BCC NACKPACK SEQNUM,VR0; % NACK IT EXIT FROM RDATBLCK; END; % OF ERROR ZR XRA; % clear for the case MTRT RTYPE,COMMAND,1; % Scan command type DO BEGIN CASE XRA MAX FCASE MIN ECASE CHECK; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A FILE HEADER PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% FCASE: BEGIN % FILE HEADER PACKET RECEIVED BUMPOTRY VR0; IF <MCLC OLDTRY,RETRY,4; CC NL> % Retry exceeded | ^<MCLC OLDSEQ,RPSEQ,2; CC NL> THEN % MUST BE LAST SEQ MVI STATE,SESTATE % Send abort state ELSE BEGIN % Receive file name SPSPACK AY,RPSEQ,ZERO,VR0; CCALL SPACK,A; MZC NUMTRY,L'NUMTRY; % % Zero retry counter END; END; % OF REC FILE HEADER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A ERROR PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ECASE: BEGIN % Error abort MVI STATE,RESTATE; % RECEIVED ABORT CCALL ERRPACK,A,VR1=RDATA,VR0=LH:RECLEN; END; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A EOF PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ZCASE: BEGIN % End of file IF ^<MCLC SEQNUM,RPSEQ,2> THEN BEGIN % MUST BE THE RIGHT PACKET MVI STATE,SESTATE; % SENDAN ABORT ERRORCON 'Illegal packet sequence for eof in rdata- must abort'; CCALL ERRPACK,A; END % bad sequence number ELSE BEGIN ACKPACK SEQNUM,VR0; % ACK IT BUMPSEQ VR0; IF <MCLC BUFCNT,=H'0',2; CC H> THEN BEGIN % SOMETHING TO WRITE CCALL WRITEFIL,A; %IF <MCLC DATA,=C'BINARY',6> THEN CCALL WRITEFIL,A; % old END; % OF SOMETHING TO WRITE IF <TF RECVDSNF> THEN CCALL CLOSERDS,A; % CLOSE THE FILE MVI STATE,RFSTATE; % WE'RE DONE HERE END; END; % OF EOT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED A DATA PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DCASE: BEGIN % D packet with data - what we want IF ^<MCLC SEQNUM,RPSEQ,2> THEN BEGIN % WRONG PACKET NUMBER BUMPOTRY VR0; IF <MCLC OLDTRY,RETRY,4; CC L> THEN BEGIN % HAVEN'T EXCEED RETRY IF <MCLC OLDSEQ,RPSEQ,2> THEN BEGIN % PREVIOUS PACKNUM JUST ACK ACKPACK RPSEQ,VR0; % ACK OLD ONE MZC NUMTRY,L'NUMTRY; EXIT FROM RDATBLCK; END; END; MVI STATE,SESTATE; % SENDAN ABORT ERRORCON 'sequence error for D packet in rdata- must abort'; CCALL ERRPACK,A; END % bad sequence number ELSE BEGIN CCALL KGETBUFF,A,VR1=RDATA,VR0=LH:RECLEN; % DECODE PACKET ACKPACK SEQNUM,VR0; % ACK IT MMVC OLDTRY,NUMTRY,4; % KEEP OLD COUNTER ZERORTRY; % A GOOD PACKET BUMPSEQ VR0; % NEXT SEQ NUMBER END; END; % OF GOOD F PACKET ENDCASE ELSE BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % RECEIVED AN ILLEGAL PACKET %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ERRORCON 'Illegal packet type for rdata - transfer aborted'; CCALL ERRPACK,A; % PUT IN BUFFERS MVI STATE,SESTATE; % SEND ABORT STATE END; END; % OK RETRY END; % of RDATBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'RINIT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : RINIT % FUNCTION : Receives the Send init packet and decodes it % changes states % INPUT: none % % % OUTPUT : state = either 'C' complete || 'B' EOT %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RINIT: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; BUMPRTRY XRA; % Increment retry counter IF <MCLC NUMTRY,RETRY,4; CC NL> THEN % Retry exceeded MVI STATE,SESTATE % Send abort state ELSE RINIBLCK: DO BEGIN % Send end of transmisision block BCCTYPE 1; % LOOK FOR 1 BCC ON REC INIT PACKET IF ^<TF SERVERF> THEN CCALL RPACK,A; EXIT IF <TF STOPF>; % Leave if user entered stop IF <RNZ VRF> THEN BEGIN % NACK if Timeout or Bad BCC NACKPACK SEQNUM,VR0; % NACK IT EXIT FROM RINIBLCK; END; % OF ERROR ZR XRA; % clear for the case MTRT RTYPE,COMMAND,1; % Scan command type DO BEGIN CASE XRA MAX SCASE MIN ECASE CHECK; RSTATE: BEGIN % SEND INIT PACKET RECEIVED CCALL RPAR,A,VR1=RDATA,VR0=LH:RECLEN; % GET PARMS CCALL SPAR,A,VR1=PDATA,VR0=LH:RECLEN; % SET PARMS SPSPACK AY,SEQNUM,RECLEN,VR0; CCALL SPACK,A; SELECT FIRST; <CLI TRFBCC,1>: BCCTYPE 1; <CLI TRFBCC,2>: BCCTYPE 2; <CLI TRFBCC,3>: BCCTYPE 3; ENDSEL; ZERORTRY; % % Zero retry counter BUMPSEQ VR0; % Increment packet counter MVI STATE,RFSTATE; % NEXT STATE REC FILE HEADER END; % OF ACK ECASE: BEGIN % Error abort MVI STATE,RESTATE; % RECEIVED ABORT CCALL ERRPACK,A,VR1=RDATA,VR0=LH:RECLEN; END; ENDCASE ELSE BEGIN ERRORCON 'Illegal packet type for rec init - transfer aborted'; CCALL ERRPACK,A; % PUT IN BUFFERS MVI STATE,SESTATE; % SEND ABORT STATE END; END; % OK RETRY END; % of RINIBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'DSNPACK'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : DSNPACK % FUNCTION : Scans data set name from a received packet % calls scandsn to check if ok % INPUT: VR1-> DATA SET NAME % VR0=LENGTH OF DATA SET NAME % % OUTPUT : VRF=0 A GOOD DSNAME ELSE INVALID NAME %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DSNPACK: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; IF <RP VR0> THEN BEGIN % GET NAME FROM SENDER LR XRA,VR0; L XRB,ATOEVCON; EXI XRA,TR,0((*-*),VR1),0(XRB),DECR=YES,INCR=YES; EXI XRA,TR,0((*-*),VR1),UPPER,DECR=YES,INCR=YES; % UPPER LA XRB,0(XRA,VR1); % SET UP TO SCAN OFF BAD CHARACTERS SI XRB,1; % ONE LESS WHILE <<CLI 0(XRB),C' '> | <CLI 0(XRB),C'.'>> DO BEGIN SI XRA,1; SI XRB,1; END; LR VR0,XRA; % LENGTH END; % OF NON LENGTH CCALL CHKRDSN,A; % CHECK THE DSNAME USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'CHKRDSN'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : CHKRDSN % FUNCTION : Checks for a valid data set name for a received % file calls scandsn to check if ok % INPUT: VR1-> DATA SET NAME % VR0=LENGTH OF DATA SET NAME % % OUTPUT : VRF=0 A GOOD DSNAME ELSE INVALID NAME %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CHKRDSN: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; CCALL SCANDSN,A; % SET UP DATA SET NAME CASE VRF MIN 0 MAX 20 CHECK; 0: BEGIN % A GOOD RETURN; END; 4: BEGIN % GOOD RETURN PLUS PDS ZR VRF; END; 8: BEGIN % WILD CARD ERRORCON 'Asterisk illegal on receive - just leave blank'; END; 12: BEGIN % NO LENGTH ERRORCON 'No length on data set name'; END; 16: BEGIN % ILLEGAL NAME ERRORCON 'Non-standard data set name '; % LR XRA,VR0 ; % EXI XRA,MMVC,OUTMESS,0(VR1),*-*,INCR=YES,DECR=YES ; % LA VR1,OUTMESS ; % SET UP BUFFER % AR VR1,XRA ; % LH XRA,DSNLEN ; % L XRB,DSNADD ; % EXI XRA,MMVC,0(VR1),0(XRB),*-*,INCR=YES,DECR=YES ; % AR VR0,XRA ; % GET LENGHT % LA VR1,OUTMESS ; END; 20: BEGIN % NO MATCHING ENTRIES FROM WILD CARD ERRORCON 'No matches in catalog for wildcard'; END; ENDCASE ELSE BEGIN % ILLEGAL RETURN ERRORCON 'Illegal data set name return'; END; IF <RZ VRF> THEN BEGIN LOCATE DATASET; % DOES IT EXIT IF <RZ VRF> THEN BEGIN % DATASET EXISTS IF ^<TF PDSF> THEN BEGIN % PDS MUST EXIST IF <TF SERVERF> THEN BEGIN ERRORCON 'Data set exists - in server mode this causes termination'; CCALL ERRPACK,A; % PUT IN OUTPUT BUFFER MMVC TEMP,=C'NO',2; % MAKE NEXT SECTION ABORT END % OF SERVER FUNCTION ELSE BEGIN % NON SERVER WRTERM 'Data set exists - reply "YES" to destroy old file '; TGET TEMP,3; MTR TEMP,UPPER,3; % UPSHIFT IT END; % OF NON SERVER IF <MCLC TEMP,=C'YES',3> THEN BEGIN SCRATCH DELDSN; % DESTROY THE DATA SET CATALOG UNCAT; % UNCATALOGE IT ZR VRF; % GOOD RETURN END % OF NON PDS ELSE BEGIN ERRORCON 'Data set already exists'; CCALL ERRPACK,A; MVI STATE,SESTATE; % ABORT LI VRF,4; % ERROR RETURN END; END % OF DELETION ELSE BEGIN % ABORT THE SUCKER % MVI STATE,SESTATE; LI VRF,0; % GOOD PDS - DO BUILDL HERE END; % OF NO END % OF EXISTIN G DATA SET ELSE BEGIN IF <TF PDSF> THEN BEGIN % PDS'S MUST EXIST ERRORCON 'PDS directory must exist - will create member -'_ 'must abort'; IF <TF SERVERF> THEN CCALL ERRPACK,A ELSE TPUT (VR1),(VR0); MVI STATE,SESTATE; LI VRF,4; % NO GOOD END % PDS ELSE ZR VRF; % GOOD RETURN FOR NON-EXISTENT DATA SET END; % NON EXISTENT DATA SET END % GOOD VRF ELSE BEGIN % BAD DSN CCALL ERRPACK,A; END; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; OUTMESS: DS CL92 ; LTORG; EXORG; SUBTITLE 'KGETBUFF'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % MODULE NAME - KGETBUFF % % % FUNCTION- TAKES DATA VR1-> DATA % VR0=LENGTH SEARCHES FOR QUOTE CHARACTES % UPDATES OUTPUT BUFFER, CALLS PUTEM WHICH WRITES FILE % AND PLACES ITEMS IN BUFFER % INPUTS - % % % % % OUTPUTS- % % % RETURN % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KGETBUFF: ; CENTER VRE,HIGHR,WASIZE,ENTRY=NO; ST VR1,RDATAADD; STH VR0,RDATALEN; UNTIL <MCLC RDATALEN,=X'0000'> DO BEGIN L XRB,RDATAADD; LR VR1,XRB; LH XRE,RDATALEN; ZR XRA; % ZERO FOR CASE IF NONE FOUND EXI XRE,MTRT,0(XRB),RECTABLE,*-*,DECR=YES,INCR=YES; % SEARCH FOR CONTROL CHARACTERS CASELOOP: DO BEGIN CASE XRA MAX CASEREPT MIN 0 CHECK; 0: BEGIN % MOVE EM ALL LR VR0,XRE; CCALL PUTEM,A; % PUT ALL IN OUT BUFFER MZC RDATALEN,2; % ZERO COUNTER END; CASEQUO: BEGIN % A QUOTE CHARACTER IF ^<CR VR1,XRB> THEN MOVEALL; % MOVE OTHER STUFF %IF <MCLC RDATALEN,=X'0001',2> THEN <SF QUOFLAG; MZC RDATALEN,2> DO BEGIN AI VR1,1; % POINT TO CHARACTER IF <MCLC DATA,=C'TEXT',4> THEN BEGIN SELECT FIRST; <CLI 0(VR1),X'4D'>: BEGIN IF <MCLC 1(VR1),LFCR+2,2> | <<CLI 1(VR1),X'26'> & <MCLC 2(VR1),LFCR+2,2>> THEN BEGIN CCALL WRITEFIL,A; IF <CLI 1(VR1),X'26'> THEN DECRDATA VR0,5 ELSE DECRDATA VR0,4; EXIT FROM CASELOOP; END ELSE BEGIN CNTLLOC 0(VR1); % PUT IT IN ZR VR0; LI VR0,1; CCALL PUTEM,A; % STICK IT IN BUFFER IF <MCLC RDATALEN,=H'2',2> THEN SF CRFLAG ELSE ZF CRFLAG; DECRDATA VR0,2; EXIT FROM CASELOOP; END; % OF LFCR END; <CLI 0(VR1),X'4A'>: BEGIN IF <TF CRFLAG> THEN BEGIN LH VR0,BUFCNT; SI VR0,1; % CNTL LF LAST CHARACTER OMIT STH VR0,BUFCNT; CCALL WRITEFIL,A; DECRDATA VR0,2; EXIT FROM CASELOOP; END ELSE BEGIN CNTLLOC 0(VR1); LI VR0,1; CCALL PUTEM,A; DECRDATA VR0,2; EXIT FROM CASELOOP; END; % OF ELSE END; <MCLC 0(VR1),TABCHAR#,1>: BEGIN IF <TF TABF> THEN BEGIN % TAB FUNCTION CCALL GETTABS,A; % ROUTINE RETURNS NUMBER OF BLANKS NECESSARY IF <RP VRF> THEN BEGIN LR VR0,VRF; % NUMBER OF BLANKS CCALL PUTEM,A,VR1=ASCBLANK; % PUT ASCII BLANKS IN FILE END; % OF TABBING EXISTS DECRDATA VR0,2; % DECREMENT BY TWO EXIT FROM CASELOOP; END; END; % OF SELECT ENDSEL; END; % OF TEXT SELECT FIRST; <MCLC 0(VR1),QUOCHAR,1>: ; % JUST DROP OUT CONTROL <MCLC 0(VR1),BINQC,1>: ; % DONT CNTL QUOTES <MCLC 0(VR1),REPTCHAR,1>: DO IF ^<TF REPTF> THEN CNTLLOC 0(VR1); ENDSEL ELSE CNTLLOC 0(VR1); % IT'S A CONTROL CHARACTER LI VR0,1; CCALL PUTEM,A; % PUT IT IN BUFFER AR VR1,VR0; ST VR1,RDATAADD; % NEW ADD ADDRESS LH VR0,RDATALEN; SI VR0,2; STH VR0,RDATALEN; % STORE OFF NEW LENGTH END; % OF ELSE SELECT END; CASE8BIT: BEGIN IF ^<CR VR1,XRB> THEN MOVEALL; % MOVE OTHER STUFF EIGHTBLK: DO BEGIN AI VR1,1; % POINT TO CHARACTER IF <MCLC DATA,=C'TEXT',4> THEN BEGIN CCALL ATOE8BIT,A ; % ERROR NO REAL HIGH ORDER BITS ON DECRDATA VR0,1 ; % EXIT FROM EIGHTBLK ; % LEAVE BLOCK END ; IF <MCLC 0(VR1),QUOCHAR,1> THEN BEGIN IF <MCLC RDATALEN,=X'0003'; CC NL> THEN BEGIN DECRDATA VR0,3; % DECREMENT RDATA AI VR1,1; END ELSE BEGIN SF QUO8FLAG; SF QUOFLAG; MZC RDATALEN,2; % OUTTA HERE EXIT FROM CASELOOP; END; % OF ONLY 2 LEFT AND QUOTED SELECT FIRST; <MCLC 0(VR1),QUOCHAR,1>: ; % JUST DROP OUT CONTROL <MCLC 0(VR1),BINQC,1>: ; % DONT CNTL QUOTES <MCLC 0(VR1),REPTCHAR,1>: DO IF ^<TF REPTF> THEN CNTLLOC 0(VR1); ENDSEL ELSE CNTLLOC 0(VR1); % IT'S A CONTROL CHARACTER END % OF QUOTE CHARACTER ELSE BEGIN % ANY OTHER CHARACTER DECR = 2 LH VR0,RDATALEN; SI VR0,2; STH VR0,RDATALEN; END; OI 0(VR1),X'80'; % OR TURN ON HIGH ORDER BIT ZR VR0; LI VR0,1; % ONE CHARACTER CCALL PUTEM,A; AI VR1,1; % INCREMENT TO NEXT ST VR1,RDATAADD; % POINTER TO NEX END; % OF ELSE END; % CASE8BIT CASEREPT: BEGIN % REPEAT CHARACTER IF <MCLC RDATALEN,=H'3'; CC L> THEN BEGIN % NOT ENOUGH WRTERM 'ERROR IN REPEAT COUNT IN RECEIVE'; END ELSE BEGIN IF ^<CR VR1,XRB> THEN MOVEALL; % MOVE OTHER STUFF AI VR1,1; % POINT TO LENGTH CHARACTER ZR VR0; IC VR0,0(VR1); UNCHAR VR0; % GET THE LENGTH IF <CI VR0,94; CC H> | <RNP VR0> THEN BEGIN % SIZE ERROR WRTERM 'REPEAT COUNT TOO LARGE ON RECEIVE 94 MAXIMUM'; END; % OF TOO LARGE AI VR1,1; % POINT TO NEXT ZR XRA; LI XRA,3; % DEFAULT LENGTH TO DECREMENT ZF HIGHBITF; % TURN OFF FLAG SELECT; <MCLC 0(VR1),BINQC,1>: BEGIN % 8 BIT QUOTING AI VR1,1; % MOVE POINTER AI XRA,1; % DECREMENT LENGTH SF HIGHBITF; % SET 8 BIT INDICATOR END; % 8 BIT SELECT <MCLC 0(VR1),QUOCHAR,1>: BEGIN % A CNTRL CHARACTER AI XRA,1; % BUMP DECREMENT COUNTER AI VR1,1; % POINT TO CHARACTER SELECT FIRST; <CLI 0(VR1),X'7E'>: ; % JUST DROP THROUGH DEL CHARACTER <MCLC 0(VR1),QUOCHAR,1>: BEGIN % JUST DROP OUT CONTROL %IF <TF HIGHBITF> THEN CNTLLOC 0(VR1); % END; <MCLC 0(VR1),BINQC,1>: BEGIN % DONT CNTL QUOTES %IF <TF HIGHBITF> THEN CNTLLOC 0(VR1); % END; <MCLC 0(VR1),TABCHAR#,1>: BEGIN % DONT CNTL QUOTES IF ^<TF HIGHBITF> THEN BEGIN IF <TF TABF> & <MCLC DATA,=C'TEXT',4> THEN BEGIN % TAB FUNCTION ZR XRB; LR XRB,VR0; % LOAD COUNT FOR FOR STATEMENT FOR XRB DO BEGIN % LOOP THROUGH NUMBER OF TABS CCALL GETTABS,A; % ROUTINE RETURNS NUMBER OF BLANKS NECESSARY IF <RP VRF> THEN BEGIN LR VR0,VRF; % NUMBER OF BLANKS CCALL PUTEM,A,VR1=ASCBLANK; % PUT ASCII BLANKS IN FILE END; % OF TABBING EXISTS END; % OF FOR LOOP FOR XRB TIMES DECRDATA VR0,4; % DECREMENT BY TWO EXIT FROM CASELOOP; END ELSE CNTLLOC 0(VR1); % CONTROL IT END % OF NON HIGH ORDER ON ELSE CNTLLOC 0(VR1); % CONTROL IT END; % END OF TAB <MCLC 0(VR1),REPTCHAR,1>: DO IF ^<TF REPTF> THEN CNTLLOC 0(VR1); ENDSEL ELSE CNTLLOC 0(VR1); % CONTROL IT END; % OF SECOND SELECT ENDSEL; IF <TF HIGHBITF> THEN BEGIN % TURN ON HIGH BIT IF ^<MCLC DATA,=C'TEXT',4> THEN OI 0(VR1),X'80' % TURN ON HIGH BIT ELSE CCALL ATOE8BIT,A; END; % CHECK FOR CONVERSION ERRORS SELECT FIRST; <CI XRA,3>: DECRDATA XRA,3; % 3 CHARACTERS <CI XRA,4>: DECRDATA XRA,4; % 4 CHARACTERS <CI XRA,5>: DECRDATA XRA,5; % 5 CHARACTERS ENDSEL; LR XRA,VR0; % LENGTH TO REPEAT IF <RP XRA> THEN BEGIN SI XRA,1; % ONE LESS CAUSE ALREADY USED ONE MMVC REPTBUFF,0(VR1),1; % PUT IN FIRST CHARACTER EXI XRA,MMVC,REPTBUFF+1,REPTBUFF,*-*,DECR=YES; % PUT IN REPEATS CCALL PUTEM,A,VR1=REPTBUFF; % PUT EM IN OUTPUT BUFFER END; END; % OF LONG ENOUGH EXIT FROM CASELOOP; END; % OF REPEAT CASE ENDCASE ELSE BEGIN WRTERM ' ERROR IN GETBUF SUB CASE '; END; END; % OF CASE LOOP LH VR0,RDATALEN; % PICK UP LENGTH END; % OF UNTIL 0 DATA USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; % SOME EQUATES CASEQUO: EQU 4; % HASH FOR TABLE CASE8BIT: EQU 8; % HASH FOR TABLE 8BIT CASEREPT: EQU 12; % HASH FOR REPEAT CHARACTER SUBTITLE 'PUTEM '; %%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE PUTEM %%%%%%%%%%%%%%%%%%%%%%%%%% PUTEM: CENTER VRE,HIGHR,ENTRY=NO; IF <TF QUO8FLAG> THEN <OI 0(VR1),X'80'; ZF QUO8FLAG>; % QUOTE LAST LR XRA,VR0; % LOAD FOR EXECUTE AND LATER L XRB,ADDBUF; % ADDRESS OF BUFFER AH XRB,BUFCNT; % INCREMENT INTO BUFFER LR XRE,VR0; % LENGTH IF TOO LONG DO BEGIN IF <CLI XRE,255; CC H> THEN <LI XRA,255; SI XRE,255> ELSE <LR XRA,XRE; ZR XRE;>; EXI XRA,MMVC,0(XRB),0(VR1),*-*,INCR=YES,DECR=YES; IF <MCLC DATA,=C'TEXT',4> THEN BEGIN L XRC,ATOEVCON; EXI XRA,MTR,0(XRB),0(XRC),*-*,INCR=YES,DECR=YES; % TRANSLATE IT END; % OF TEXT END; % OF TRANSLATES LR XRA,VR0; % RESTORE AH XRA,BUFCNT; % INCREMENT BUFFER COUNTER STH XRA,BUFCNT; %SELECT FIRST; IF <CH XRA,MAXWRITE; CC H> THEN BEGIN % MORE CHAR THAN LRECL SIZE % IF BINARY WRITE - IF TEXT TRUNCATION ONLY RIGHT ON REQUEST %IF <MCLC DATA,=C'BINARY',6> THEN BEGIN MMVC BUFCNT,MAXWRITE,2; % WRITE MAXWRITE'S WORTH CCALL WRITEFIL,A; % OUTPUT THE RECORD SH XRA,MAXWRITE; % GET REMAINDER L XRB,ADDBUF; LR VR1,XRB; % SET UP FOR MOVE AH XRB,MAXWRITE; % INDEX FOR MOVE EXI XRA,MMVC,0(VR1),0(XRB),*-*,INCR=YES,DECR=YES; % SH XRA,LRECL; % SUB OFF LRECL STH XRA,BUFCNT; % UPDATE BUF COUNTER %END; % OF BINARY - TEXT JUST FALLS THROUGH % END; % OF MORE CHARACTERS %<CH XRA,MAXWRITE; CC =>: BEGIN % MAXWRITE EQUALS CHARACTERS % %%IF <MCLC DATA,=C'BINARY',6> THEN BEGIN %CCALL WRITEFIL,A; % OUTPUT THE RECORD %MZC BUFCNT,2; % ZERO COUNTER %%END; % OF BINARY - TEXT JUST FALLS THROUGH %END; % OF EQUAL SELECT % %<CH XRA,MAXWRITE; CC L>: ; % NO OP JUST FALL THRU %ENDSEL; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'OPENSDSN'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : OPENSDSN % FUNCTION : OPENS AND ALLOCATES THE DATA SET KERIN % CALLED BY SEND FUNCTIONS % INPUT: NONE % % % OUTPUT : VRF=0 GOOD OPEN, VRF=4 ERROR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% OPENSDSN: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; KINBLCK: DO BEGIN MMVC KERMDDNM,=C'KERIN ',8; % SET UP DDNAME IF ^<TF PDSF> THEN BEGIN % A REGULAR DATA SET DALLIST BEGIN,MF=(E,KFILEIN),INIT=NO; BEGIN DALLIST TEXT,DALDDNAM,(KERMDDNM,8); % DDNAME DALLIST TEXT,DALDSNAM,(DSNAME,DSNSIZE); % DSNAME DALLIST TEXT,DALSTATS,(X'08',1,'STC'); % STATUS SHARE DALLIST END; END; END ELSE BEGIN % A PDS MEMBER DALLIST BEGIN,MF=(E,KFPDSIN),INIT=NO; BEGIN DALLIST TEXT,DALDDNAM,(KERMDDNM,8); % DDNAME DALLIST TEXT,DALDSNAM,(DSNAME,DSNSIZE); % DSNAME DALLIST TEXT,DALSTATS,(X'08',1,'STC'); % STATUS SHARE DALLIST TEXT,DALMEMBR,(DSMEMBER,8); % MEMBER NAME DALLIST END; END; END; % PDS ST VRF,DACKRC; % RETURN CODE FROM ALLOCATE IF <RNZ VRF> THEN BEGIN % ERROR IN ALLOCATION? IF <TF PDSF> THEN L VR1,KFPDSIN ELSE L VR1,KFILEIN; % POINT TO DYNAL BLOCK IF <CI VRF,16> & <MCLC 4(VR1),=X'035C0002',4> THEN BEGIN ERRORCON 'Non-Standard MVS data set name' ; CCALL ERRPACK,A ; MVI STATE,ASTATE ; IF ^<TF SERVERF> THEN TPUT (VR1),(VR0) ; END ELSE CCALL DYNERR,A; % CALL ERROR ROUTINE EXIT FROM KINBLCK; END; DATA BEGIN % DYNAMIC ALLOCATION PARAMETER LIST FOR INPUT DATA SET KFILEIN: DALLIST BEGIN,S99VRBAL,_ FLAGS1=(S99NOMNT),_ ERROR=KERMERR,INFO=KERMINFO,MF=L; BEGIN DALLIST TEXT,DALDDNAM,(,8); % DDNAME DOUDSNAM: DALLIST TEXT,DALDSNAM,(,DSNSIZE); % DSNAME DALLIST TEXT,DALSTATS,X'08'; % STATUS DALLIST END; END; KFPDSIN: DALLIST BEGIN,S99VRBAL,_ FLAGS1=(S99NOMNT),_ ERROR=KPDSERR,INFO=KPDSINFO,MF=L; BEGIN DALLIST TEXT,DALDDNAM,(,8); % DDNAME DALLIST TEXT,DALDSNAM,(,DSNSIZE); % DSNAME DALLIST TEXT,DALSTATS,X'08'; % STATUS DALLIST TEXT,DALMEMBR,(,8); % PDS MEMBER DALLIST END; END; END; % MAKE SURE NON EDIT FORMAT IF <MCLC DATA,=C'BINARY',6> THEN BEGIN CALL EDSET,(EDCNTRL,EDRETURN,SIX,TWO,TEMP,EDLEN); END ; CALL EDOPEN,(EDCNTRL,EDRETURN,KERMDDNM,ONE); IF ^<MCLC EDRETURN,ZERO,4> THEN BEGIN % FILE OPEN FAIL ZF SENDDSNF; % INDICATE NOT OPEN CALL EDMSG,(EDCNTRL,EDRETURN,EDLINE,EDLMAX2,EDLENACT); L VR0,EDLENACT; CCALL ERRPACK,A,VR1=EDLINE; % OUTPUT IT LI VRF,4; % ABORT IT EXIT FROM KINBLCK; END ELSE SF SENDDSNF; % OPEN INDICATOR ZF KINEOF; % END OF FILE INDICATOR CALL EDSHOW,(EDCNTRL,EDRETURN,ONEOONE,TEMP,EDLINE,EDLMAX2,EDLENACT); SELECT FIRST; <CLI EDLINE,C'V'>: MVI RRECFM,C'V'; <CLI EDLINE,C'F'>: MVI RRECFM,C'F'; <CLI EDLINE,C'U'>: MVI RRECFM,C'U'; ENDSEL ELSE BEGIN ERRORCON ' Only V, U and F RECFM supported '; CCALL ERRPACK,A; % PUT IN BUFFER MVI STATE,ASTATE; % ABORT IT LI VRF,4; % ERROR END; % ELSE SELECT ZR VRF; % INDICATE A GOOD OPEN END; % OF KINBLCK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'OPENRDSN'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : OPENRDSN % FUNCTION : OPENS DATA SET KEROUT FOR DOWNLOAD TO MICRO % GETS SPACE FOR FILE BUFFER % INPUT: OPENS DSNAME AND IF PDS DSMEMBER % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% OPENRDSN: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; OPENOBLK: DO BEGIN % BLOCK TO FALL OUT OF MMVC KERMDDNM,=C'KEROUT ',8; % SET UP DDNAME IF ^<TF PDSF> THEN BEGIN % NON PDS LH VR0,LRECL; ST VR0,TEMP; CALL EDSET,(EDCNTRL,EDRETURN,ONE,TEMP,TEMP,EDLEN); % LRECL LH VR0,BLKSIZE; ST VR0,TEMP; CALL EDSET,(EDCNTRL,EDRETURN,TWO,TEMP,TEMP,EDLEN); % BLKSIZE IF <TF EDITF> & ^<MCLC DATA,=C'BINARY',6> THEN BEGIN CALL EDSET,(EDCNTRL,EDRETURN,SIX,ONE,TEMP,EDLEN); END ELSE % NON EDIT FORMAT CALL EDSET,(EDCNTRL,EDRETURN,SIX,TWO,TEMP,EDLEN); IF <CLI RFM,C'U'> | <CLI RFM+1,C' '> THEN % UNDEFINED OR UNBLOCKED CALL EDSET,(EDCNTRL,EDRETURN,ONEOONE,TEMP,RFM,ONE) ELSE CALL EDSET,(EDCNTRL,EDRETURN,ONEOONE,TEMP,RFM,TWO); % CALL EDNGEN,(EDCNTRL,EDRETURN,TWO,ONE,ONE); % END; % ON NON PDS LOCATE DATASET; % DOES IT EXIST IF <RZ VRF> THEN BEGIN % DATASET EXISTS IF ^<TF PDSF> THEN BEGIN ERRORCON 'Data set already exists'; CCALL ERRPACK,A; MVI STATE,SESTATE; EXIT FROM OPENOBLK; % NO FILE END; % ON NON PDS END; % OF NO IF <TF PDSF> THEN BEGIN MVI OUTSTATS,X'01'; % ANOLD VOLUME MVI OUTNDISP,X'08'; % DISPOSITION CATALOG MVI OUTCDISP,X'08'; % DISPOSITION KEEP END ELSE BEGIN MVI OUTSTATS,X'04'; % A NEW VOLUME MVI OUTNDISP,X'02'; % DISPOSITION CATALOG MVI OUTCDISP,X'02'; % DISPOSITION CATALOG END; IF <MCLC DATA,=C'BINARY'> THEN BEGIN % NO LINE NUMBERS CALL EDNCOL,(EDCNTRL,EDRETURN,ONE,EDCOL1,EDCOL2); END % OF BINARY FILE ELSE BEGIN % TEXT FILE IF ^<TF EDITF> THEN CALL EDNCOL,(EDCNTRL,EDRETURN,EDTYPE,EDCOL1,EDCOL2); IF ^<MCLC EDTYPE,ONE,4> THEN BEGIN CALL EDNGEN,(EDCNTRL,EDRETURN,TWO,ONETHOU,ONETHOU); END; END; % OF TEXT FILE CCALL KRDYNAL,A; % CALL DYNAL SUB IF <RNZ VRF> THEN BEGIN % ERROR IN DYNAL MVI STATE,SESTATE; EXIT FROM OPENOBLK; % NONE ZERO PROBLEM END; % OF DYNAL ERROR CALL EDOPEN,(EDCNTRL,EDRETURN,KERMDDNM,ONEOONE); % OUTPUT IF ^<MCLC EDRETURN,ZERO,4> THEN BEGIN % FILE OPEN FAIL CALL EDMSG,(EDCNTRL,EDRETURN,EDLINE,EDLMAX2,EDLENACT); L VR0,EDLENACT; % LENGTH OF MESSAGE CCALL ERRPACK,A,VR1=EDLINE; % PUT IN OUTPUT BUFFER MVI STATE,SESTATE; % ABORT IT EXIT FROM OPENOBLK; END ELSE SF RECVDSNF; % OPEN FLAG INDICATOR CALL EDSHOW,(EDCNTRL,EDRETURN,ONEOONE,TEMP,EDLINE,EDLMAX2,EDLENACT); MMVC RRECFM,EDLINE,1; % RETURNED REC FORMAT CALL EDSHOW,(EDCNTRL,EDRETURN,THREE,TEMP,EDLINE,EDLMAX2,EDLENACT); MMVC MAXWRITE,TEMP+2,2; % SIZE OF BUFFER AI XRA,200; % EXTRA SPACE FOR BUFFER GETMAIN RC,LV=32777,SP=7; % GET MAIN FOR WORKBUFFER IF <RNZ VRF> THEN BEGIN ERRORCON ' GET MAIN ERROR - NO ENOUGH REGION FOR RECEIVE BUFFER '; CCALL ERRPACK,A; MVI STATE,SESTATE; END; % OF FAILED GETMAIN ST VR1,ADDBUF; % ADDRESS OF STORAGE END; % OF OPENOBLK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; SUBTITLE 'KRDYNAL'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE - R DYNAL % FUNCTION - PERFORMS DYNAMIC ALLOCATION % FOR RECEIVE MODULE % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % KRDYNAL: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; ZR VRF; % ZERO REGISTER IF <TF PDSF> THEN BEGIN % WE HAVE A PDS MZC LTRK,4; % TRACKS MZC LPRIME,4; MZC LSECND,4; MZC LRLSE,4; MZC LVLSER,4; MMVC PDSMEM1,PDSMEM2,4; % INDICATE MEMBER MMVC PDSORG1,PDSORG2,4; END % OF PDS ELSE BEGIN MZC PDSMEM1,4; % INDICATE NO MEMBER MZC PDSORG1,4; MMVC LTRK,TTRK,4; % TRACKS MMVC LPRIME,TPRIME,4; MMVC LSECND,TSECND,4; MMVC LRLSE,TRLSE,4; L XRA,TMPDISKA; LH XRB,TMPDISKL; LA VR1,VOLUME; IF <EXI XRB,MCLC,0(XRA),0(VR1),*-*,INCR=YES,DECR=YES> THEN BEGIN AR VR1,XRB; % POINT TO END LI XRC,6; % VOL LENGTH SR XRC,XRB; % REMAINING BLANKS IF <EXI XRC,MCLC,0(VR1),BLANKS,*-*,INCR=YES,DECR=YES> THEN MZC LVLSER,4 % LET SYSTEM FIND THE VOLUME ELSE MMVC LVLSER,TVLSER,4; END ELSE MMVC LVLSER,TVLSER,4; END; % OF NON PDS DO BEGIN DALLIST BEGIN,MF=(E,NOVOL),INIT=NO; BEGIN % LET SYSTEM SELECT DALLIST TEXT,DALDDNAM,(KERMDDNM,8); % DDNAME DALLIST TEXT,DALDSNAM,(DSNAME,DSNSIZE); % DSNAME DALLIST TEXT,DALMEMBR,(DSMEMBER,8); % MEMBER NAME % DALLIST TEXT,DALUNIT,(OUTUNIT,8); % UNIT ADDRESS DALLIST TEXT,DALSTATS,(OUTSTATS,1); % STATUS DALLIST TEXT,DALNDISP,(OUTNDISP,1); % NORMAL DISPOSITION DALLIST TEXT,DALCDISP,(OUTCDISP,1); % CONDITIONAL DISPOSITION DALLIST TEXT,DALTRK,MF=L; % SPACE IN TRACKS DALLIST TEXT,DALPRIME,(TRACK+1,3); % PRIMARY SPACE DALLIST TEXT,DALSECND,(TRACK+1,3); % SECONDARY SPACE DALLIST TEXT,DALRLSE,MF=L; % RELEASE UNUSED SPACE (RLSE) DALLIST TEXT,DALRTVOL,(,6); % VOLUME SERIAL NUMBER IS TO BE DALLIST TEXT,DALDSORG,(PO,2); DALLIST TEXT,DALVLSER,(VOLUME,6); % VOLUME SERIAL NUMBER DALLIST END; END; END; ST VRF,DACKRC; % RETURN CODE FROM ALLOCATE DATA BEGIN % DYNAMIC ALLOCATION PARAMETER LIST FOR OUTPUT DATA SET NOVOL: DALLIST BEGIN,S99VRBAL,_ FLAGS1=(S99NOMNT),_ ERROR=DEFERR,INFO=DEFINFO,MF=L; BEGIN DALLIST TEXT,DALDDNAM,(,8); % DDNAME DALLIST TEXT,DALDSNAM,(,DSNSIZE); % DSNAME PDSMEM1: DALLIST TEXT,DALMEMBR,(,8); % PDS MEMBER % DALLIST TEXT,DALUNIT,(,8); % UNIT ADDRESS DALLIST TEXT,DALSTATS,(,1); % STATUS DALLIST TEXT,DALNDISP,(,1); % NORMAL DISPOSITION DALLIST TEXT,DALCDISP,(,1); % CONDITIONAL DISPOSITION LTRK: % TRACKS DALLIST TEXT,DALTRK; % SPACE IN TRACKS LPRIME: DALLIST TEXT,DALPRIME,(,3); % PRIMARY SPACE LSECND: DALLIST TEXT,DALSECND,(,3); % SECONDARY SPACE LRLSE: DALLIST TEXT,DALRLSE,MF=L; % RELEASE UNUSED SPACE (RLSE) RECVOL: DALLIST TEXT,DALRTVOL,(,6); % RETURN VOLUME SERIAL PDSORG1: DALLIST TEXT,DALDSORG,(,2); LVLSER: DALLIST TEXT,DALVLSER,(,6); % VOLUME SERIAL NUMBER DALLIST END; END; END; MMVC TSOVOL,RECVOL+6,6; % RETURNED VOLUME NAME %END; % OF DEFAULT DATA BEGIN % A SPECIFIC VOLUME DO BEGIN DALLIST BEGIN,MF=(E,MOVEOUT),INIT=NO; BEGIN DALLIST TEXT,DALDDNAM,(KERMDDNM,8); % DDNAME DALLIST TEXT,DALDSNAM,(DSNAME,DSNSIZE); % DSNAME DALLIST TEXT,DALMEMBR,(DSMEMBER,8); % MEMBER NAME % DALLIST TEXT,DALUNIT,(OUTUNIT,8); % UNIT ADDRESS DALLIST TEXT,DALVLSER,(VOLUME,6); % VOLUME SERIAL NUMBER DALLIST TEXT,DALSTATS,(OUTSTATS,1); % STATUS DALLIST TEXT,DALNDISP,(OUTNDISP,1); % NORMAL DISPOSITION DALLIST TEXT,DALCDISP,(OUTCDISP,1); % CONDITIONAL DISPOSITION DALLIST TEXT,DALTRK,MF=L; % SPACE IN TRACKS DALLIST TEXT,DALPRIME,(TRACK+1,3); % PRIMARY SPACE DALLIST TEXT,DALSECND,(TRACK+1,3); % SECONDARY SPACE DALLIST TEXT,DALRLSE,MF=L; % RELEASE UNUSED SPACE (RLSE) % FROM DATA SET ASSOCIATED WITH THIS DDNAME % RETURNED DALLIST END; END; END; ST VRF,DACKRC; % RETURN CODE FROM ALLOCATE DATA BEGIN % DYNAMIC ALLOCATION PARAMETER LIST FOR OUTPUT DATA SET MOVEOUT: DALLIST BEGIN,S99VRBAL,_ FLAGS1=(S99NOMNT),_ ERROR=MOUTERR,INFO=MOUTINFO,MF=L; BEGIN DALLIST TEXT,DALDDNAM,(,8); % DDNAME DALLIST TEXT,DALDSNAM,(,DSNSIZE); % DSNAME PDSMEM2: DALLIST TEXT,DALMEMBR,(,8); % PDS MEMBER % DALLIST TEXT,DALUNIT,(,8); % UNIT ADDRESS TVLSER: DALLIST TEXT,DALVLSER,(,6); % VOLUME SERIAL NUMBER DALLIST TEXT,DALSTATS,(,1); % STATUS DALLIST TEXT,DALNDISP,(,1); % NORMAL DISPOSITION DALLIST TEXT,DALCDISP,(,1); % CONDITIONAL DISPOSITION TTRK: DALLIST TEXT,DALTRK; % SPACE IN TRACKS TPRIME: DALLIST TEXT,DALPRIME,(,3); % PRIMARY SPACE TSECND: DALLIST TEXT,DALSECND,(,3); % SECONDARY SPACE TRLSE: DALLIST TEXT,DALRLSE,MF=L; % RELEASE UNUSED SPACE (RLSE) PDSORG2: DALLIST TEXT,DALDSORG,(,2); DALLIST END; END; END; END; ST VRF,TEMP+4; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF ST VRF,DACKRC; % RETURN CODE FROM ALLOCATE IF <RNZ VRF> THEN BEGIN % ERROR IN ALLOCATION? L VR1,NOVOL; CCALL DYNERR,A; % CALL ERROR SUB %WRTERM 'Error in Dynamic Allocation REC CMD '_ %'Unable to allocate file '; %CVBTX TEMP,4,TEMP+4; %VSEG KERMVA,'Dynamic reg 15 return '; %VSEG KERMVA,TEMP,4; %VOUT KERMVA; %VSEG KERMVA,'The dynamic error code = '; %CVBTX TEMP,4,MOUTERR; %VSEG KERMVA,TEMP,4; %VOUT KERMVA; %VSEG KERMVA,'The dynamic info code = '; %CVBTX TEMP,4,MOUTINFO; %VSEG KERMVA,TEMP,4; %VOUT KERMVA; %MVI STATE,ASTATE; % ABORT IT END; RDYNEXIT: CEXIT VRE,HIGHR; LTORG; EXORG; PDSORGTL: DC X'003C0001'; PO: DC X'0200'; % PARTIONED DS SUBTITLE 'DYNERR'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE - DYNERR % FUNCTION - CALLS MACROS FOR DYNAL ROUTINES % INPUT VR1-> DYNAL REQUEST BLOCK % OUTPUT SCREEN INFORMATION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DYNERR: CENTER VRE,HIGHR,ENTRY=NO; ST VR1,TEMP; % STORE OFF REGS VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN; DALMSG DALLIST=TEMP,RC=DACKRC,MF=(E,DALMSG); % OBTAIN TEXT OF DATA BEGIN DALMSG: DALMSG MSG1=DAIRMSG1,MSG1LEN=DAIRLEN1,MSG2=DAIRMSG2,_ MSG2LEN=DAIRLEN2,MF=L; % PARAMETER LIST FOR OBTAINING DYNAMIC END; % OF DATA % DYNAMIC ALLOCATION ERROR MESSAGE LH VR0,DAIRLEN1; % GET LENGTH OF FIRST MESSAGE LR XRA,VR0; % SAVE THE REGISTER IF <RP VR0> THEN BEGIN % ANY MESSAGE PRESENT? LA VR1,DAIRMSG1; UNTIL <CLI 0(VR1),C' '> DO <SI VR0,1; AI VR1,1>; UNTIL <CLI 0(VR1),C' '; CC NE> DO <SI VR0,1; AI VR1,1>; CCALL ERRPACK,A; %IF ^<TF SERVERF> THEN VOUT KERMVA,DAIRMSG1,(VR0); % OF FIRST DYNAMIC %STH XRA,STATLEN; % STATUS ROUTINE %LR XRA,VR0; % STATUS REGISTER %EXI XRA,MMVC,STATBUFF,DAIRMSG1,*-*,INCR=YES,DECR=YES; %CCALL ERRPACK,A,VR1=STATBUFF; % PUT IT IN ERROR PACK % ALLOCATION ERROR MESSAGE END; LH VR0,DAIRLEN2; % GET LENGTH OF SECOND MESSAGE IF <RP VR0> THEN BEGIN % ANY MESSAGE PRESENT? %IF ^<TF SERVERF> THEN VOUT KERMVA,DAIRMSG2,(VR0); %TEXT SECOND DYNAMIC % ALLOCATION ERROR MESSAGE END; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'WRITEFIL'; WRITEFIL: CENTER VRE,HIGHR,ENTRY=NO; %%%%%%%%%%%%%% PUT TO FILE LH XRB,BUFCNT; % NUMBER TO PUT IF <RNM XRB> THEN BEGIN % IF WE HAVE SOMETHING TO PUT ST XRB,EDLEN; % NUMBER OF CHARACTERS TO PUT L XRA,ADDBUF; % ADDRESS OF BUFFER CALL EDPUT,(EDCNTRL,EDRETURN,EDLINEN,EDLINER,(XRA),EDLEN); IF ^<MCLC EDRETURN,ZERO,4> THEN BEGIN % FILE OPEN FAIL CALL EDMSG,(EDCNTRL,EDRETURN,EDLINE,EDLMAX2,EDLENACT); CCALL ERRPACK,A,VR1=EDLINE,VR0=L:EDLENACT; % OUTPUT IT END; IF <OPENP DEBUG> THEN BEGIN DATA BEGIN DBMSG1: DC C'QSAM PUT'; DS 4CL1; % INCLUDE FOR WORD SIZE DBMSG1L: EQU *-DBMSG1; END; ZR VR1; LI VR1,DBMSG1L; STH VR1,WRKBUFF; MZC WRKBUFF+2,2; % ZERO REST MMVC WRKBUFF+4,DBMSG1,8; PUT DEBUG,WRKBUFF; % OUT PUT IT AI XRB,4; % INCLUDE FOUR FOR HEADER LR VR1,XRB; % RESTORE LENGTH IF <CH VR1,DEBUG+(DCBLRECL-IHADCB); CC H> THEN LH VR1,DEBUG+(DCBLRECL-IHADCB); IF <CI VR1,255; CC H> THEN <LI VR1,255>; EXI VR1,MMVC,BUF,(XRA),0,INCR=YES,DECR=YES; % MOVE IT OVER STH VR1,BUF-4; % STORE OFF LENGTH MZC BUF-2,2; PUT DEBUG,BUF-4; LR VR1,XRB; % RESTORE LENGTH END; % OF DEBUG END; % OF SOMETHING TO PUYT IF <MCLC DATA,=C'TEXT',4> THEN MZC BUFCNT,2; % ZERO BUFFER COUNT L VR1,ADDBUF; ST VR1,BUFADD; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'KSPACK'; SPACK: % SEND PACKET TO MICRO CENTER VRE,HIGHR,ENTRY=NO; LA XRC,SNDPKT; USE XRC AS PACKET IN BEGIN % ADRESSABLE DSECT SPACKBLK: DO BEGIN MMVC MARK,SSOH,1; % MOVE IN SEND START OF HEADER LENCALC XRB; % CALCULATE THE LENGTH CHAR XRB; STC XRB,LEN; % PUT IN LENGTH UNCHAR XRB; % NUMERIC AI XRB,1; % ONE MORE FOR THE LENGTH BYTE SH XRB,BCCLEN; % GET RID OF BCC FOR SUB LR VR0,XRB; % SET UP FOR SUB CCALL BCCCALC,A,VR1=LEN; % BCC COMPUTATION SUB EXIT FROM SPACKBLK IF <C VRF,=X'FFFFFFFF'>; % SOMETHING FUNNY LENCALC XRB; % LENGTH AI XRB,2; % INCLUDE FIRST TWO BYTES LA VR1,PACKET; SH VR1,BCCLEN; AR VR1,XRB; % ONE LESS LH XRA,BCCLEN; % LENGTH FOR STM SI XRA,1; % DECREMENT FOR EXECUTE EX XRA,STOREBCC; % ST BCC L VRF,ATOEVCON; EXI XRB,MTR,PACKET,0(VRF),*-*,DECR=YES,INCR=YES; % TRANSLATE TO EBCIDIC IF <OPENP DEBUG> THEN BEGIN % DEBUGGING ON MZC WRKBUFF,4; % BLAST 1ST 4 BYTES MVI WRKBUFF+1,20; MMVC WRKBUFF+4,=C'TPUT SEND PACKET',16; PUT DEBUG,WRKBUFF; AI XRB,4; % BUMP LENGTH COUNTER TO INCLUDE HEADER STH XRB,WRKBUFF; EXI XRB,MVC,WRKBUFF+4(*-*),PACKET,DECR=YES,INCR=YES; SI XRB,4; % ADJUST LENGTH BACK TO ORIGINAL PUT DEBUG,WRKBUFF; % OUTPUT AGAIN END; % OF DEBUG BLOCK LA XRA,SNDPKT; AR XRA,XRB; % LENGTH OF PACKET MMVC 0(XRA),SEOL,1; % PUT ON EOL CHARACTER L VRF,ATOEVCON; MTR 0(XRA),0(VRF),1; % TRANSLATE TO EBCIDIC FOR TCAM AI XRB,1; % BUMP LENGTH FOR PUT IF <TF STURNRND> THEN BEGIN STIMER WAIT,BINTVL=STURNTIM; END; TPUT SNDPKT,(XRB),CONTROL; % THE BEEF IF <RNZ VRF> THEN BEGIN ERRORCON 'Error in Tput to Micro '; CCALL ERRPACK,A; END; % OF ERROR OF TPUT L VRF,ETOAVCON; EXI XRB,TR,PACKET(*-*),0(VRF),DECR=YES,INCR=YES; % TRANSLATE TO EBCIDIC END; % OF SPACKBLK CEXIT VRE,HIGHR; LTORG; EXORG; STOREBCC: MMVC 0(VR1),BCC,*-*; % ST BCC END; % OF DSECT PACKET SUBTITLE 'BCCCALC'; BCCCALC: % BCC CHECKING ROUTINE % VR1 = PACKET ADDRESS % VR0 = PACKET LENGTH LESS BCC % VRF = BCC CHECK RETURN CENTER VRE,HIGHR,WASIZE,ENTRY=NO; LH XRA,BCCLEN; % LEVEL CHECKING ZR VRF; % ZERO REG TO HOLD BCC SELECT FIRST; <CI XRA,1>: BEGIN % LEVEL 1 BCC CHECKING DO BEGIN ZR XRB; IC XRB,0(VR1); % OFFSET 1 FOR MARK AR VRF,XRB; % BUMP ACCUMULATOR AI VR1,1; % INCREMENT END FOR VR0; ST VRF,TEMP; % STORE OFF FOR ADD N VRF,=X'000000C0'; % MOD 192 M VRE,ONE; % CARRY OVER SIGN BIT D VRE,O1H; % MOD 64 A VRF,TEMP; % ADD THE TWO VALUES N VRF,MOD64; % MOD 64 CHAR VRF; STC VRF,BCC; % STORE IT OFF END; % LEVEL 1 <CI XRA,2>: BEGIN % LEVEL 2 BCC CHECKING %SI XRB,2; % SUB 2 FOR BCC DO BEGIN ZR XRB; IC XRB,0(VR1); % OFFSET 1 FOR MARK AR VRF,XRB; % BUMP ACCUMULATOR AI VR1,1; % INCREMENT END FOR VR0; LR XRB,VRF; % SAVE OFF TOTAL % FIRST CHARACTER IN BCC BITS 11-6 OF TOTAL N XRB,=X'00000FFF'; % TURN OFF ALL BUT 12 BITS SRL XRB,6; % SHIFT OVER 6 BITS CHAR XRB; % MAKE IT PRINTALBE STC XRB,BCC; % STORE OFF 1ST CHARACTER N VRF,=X'0000003F'; % ONLY LAST 6 BITS CHAR VRF; % THE CHARACTER FUNCTION STC VRF,BCC+1; % STORE IT OFF LA VRF,BCC; % RETURN ADDRESS OF BCC IN VRF END; % LEVEL 2 <CI XRA,3>: BEGIN % LEVEL 3 CRC CHECKING ZR VRF; % VRF CRC VALUE - ORIGINALLY 0 DO BEGIN ZR XRB; LR XRC,VRF; % GET SET UP FOR XOR N XRC,=X'000000FF'; % BLAST ALL BUT LAST BYTE IC XRB,0(VR1); % OFFSET 1 FOR MARK XR XRC,XRB; % X-OR CRC WITH BYTE SRL VRF,8; % SHIFT CRC REG 8 BIT TO THE RIGHT L XRB,CRCCONAD; % CRC CONSTANT TABLE CRC CCITT AR XRB,XRC; AR XRB,XRC; % ADD INDEX TWICE SINCE ALL VALUES ARE HALFWORD ICM XRC,3,0(XRB); % LOAD HALF WORD N XRC,=X'0000FFFF'; % TURN OFF HIGH ORDER XR VRF,XRC; % REMAINING CRC VALUE AI VR1,1; % INCREMENT END FOR VR0; LR XRB,VRF; % SAVE OFF TOTAL % FIRST CHARACTER IN CRC BITS 11-6 OF TOTAL N XRB,=X'0000FFFF'; % TURN OFF ALL BUT 16 BITS SRL XRB,12; % SHIFT OVER 12BITS CHAR XRB; % MAKE IT PRINTALBE STC XRB,BCC; % STORE OFF 1ST CHARACTER (B12-B15) LR XRB,VRF; % RESTORE REGISTER % SECOND CHARACTER IN CRC BITS 11-6 OF TOTAL N XRB,=X'00000FFF'; % TURN OFF ALL BUT 12 BITS SRL XRB,6; % SHIFT OVER 6 BITS CHAR XRB; % MAKE IT PRINTALBE STC XRB,BCC+1; % STORE OFF 2ND CHARACTER N VRF,=X'0000003F'; % ONLY LAST 6 BITS CHAR VRF; % THE CHARACTER FUNCTION STC VRF,BCC+2; % STORE IT OFF LA VRF,BCC; % RETURN ADDRESS OF BCC IN VRF END; % LEVEL 3 ENDSEL; % CRC SELECTION USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF BCCEXIT: CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'CHKETOA'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: CHKETOA % FUNCTION: CHECKS EBCDIC TEXT FILE FOR UNVALID ASCII CHARACTERS % INPUT: VR1=>POINTS TO STRING % VR0= LENGTH OF STRING / ALWAYS LESS THAN 256 % OUTPUT: MESSAGE OUTPUT-FLAGS SET % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CHKETOA: CENTER VRE,HIGHR,ENTRY=NO; LR XRB,VR0; % LENGTH FOR EXECUTE ZR XRA; LR VRF,VR1; % POINT OT STRING L XRC,ETOAERRV; % ADDRESS OF ETOA ERROR TABLE EXI XRB,MTRT,0(VRF),0(XRC),*-*,INCR=YES,DECR=YES; IF <RNZ XRA> THEN BEGIN SF WARNINGF; MVC WARNBUFF,=C'EDCDIC characterdoes not have ASCII equivalent.'; MMVC WARNLEN,=H'48',2; END; % OF TRANSLATE ERROR CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'STOPPROC'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : STOPPROC % FUNCTION : CLOSES OPENED DATA SEST KERIN % OR KEROUT - USER ENTERED STOP % INPUT: NONE % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% STOPPROC: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; IF <TF SENDDSNF> THEN CCALL CLOSESDS,A; IF <TF RECVDSNF> THEN CCALL CLOSERDS,A; ZF STOPF; % RESET STOP FLAG CEXIT VRE,HIGHR; LTORG; SUBTITLE 'SABORT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : SABORT % FUNCTION : SENDS AN ABORT PACKET TO THE OTHER KERMIT % DATA OF PACKET ALREADY ENTERED % INPUT: NONE % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SABORT: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; STH VR0,TEMP; IF <MCLC OLDTRY,RETRY,4; CC NL> | <MCLC NUMTRY,RETRY,4; CC NL> THEN BEGIN % Retry exceeded ERRORCON 'Retry count exceeded - transfer aborted'; CCALL ERRPACK,A; % PUT IT IN BUFFER END; % OF EXCEEDED RETRY SPSPACK AE,TEMP,PUTLEN,VR0; % INIT SEND BUFFER CCALL SPACK,A; % FIRE AWAY CCALL STOPPROC,A; % CLOSES FILES CEXIT VRE,HIGHR; LTORG; SUBTITLE 'RABORT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : RABORT % FUNCTION : ACKS AN ABORT PACKET RECEIVED FROM THE OTHER KERMIT % MOST DON'T REQUIRE THIS BUT JUST IN CASE % INPUT: NONE % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RABORT: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; SPSPACK AY,SEQNUM,ZERO,VR0; % INIT SEND BUFFER CCALL SPACK,A; % FIRE AWAY LH VR0,RECLEN; IF <CI VR0,255; CC H> THEN LI VR0,255; IF <RP VR0> THEN BEGIN LR XRB,VR0; L XRA,ATOEVCON; EXI XRB,MTR,RDATA,0(XRA),*-*,DECR=YES; END; IF <RP VR0> THEN CCALL ERRPACK,A,VR1=RDATA; % PUT IN STATUS BUFFER CCALL STOPPROC,A; CEXIT VRE,HIGHR; LTORG; SUBTITLE 'CLOSESDS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : CLOSESDS % FUNCTION : CLOSES AND DEALLOCATES THE DATA SET KERIN % CALLED BY SEND FUNCTIONS AND ABORT PROCESSING % INPUT: NONE % % % OUTPUT : NONE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CLOSESDS: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; IF <TF SENDDSNF> THEN BEGIN % CLOSE INPUT FILE CALL EDCLOS,(EDCNTRL,EDRETURN); % CLOSE INPUT FILE ZF SENDDSNF; % OPEN FILE INDICATOR END; % OF CLOSE KERIN LA XRB,DSNAME; % GET ADDRESS OF DSNAME DALLIST BEGIN,MF=(E,UALLOCDS),INIT=NO; BEGIN DALLIST TEXT,DALDDNAM,(KERMDDNM,8); % DDNAME DALLIST TEXT,DUNUNALC,MF=L; % FORCE UNALLOCATION DALLIST END; END; DATA BEGIN % DYNAMIC ALLOCATION PARAMETER LIST FOR % UNALLOCATION BY DSNAME UALLOCDS: DALLIST BEGIN,S99VRBUN,MF=L; BEGIN DALLIST TEXT,DALDDNAM,(,8); % DDNAME DALLIST TEXT,DUNUNALC; % FORCE UNALLOCATION DALLIST END; END; END; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'CLOSERDS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : CLOSERDS % FUNCTION : CLOSES THE DATA SET KEROUT USED BY RECEIVE % THE UPLOADED FILE, CALLS RECUNAL FOR DEALLOCATION % INPUT: NONE % % % OUTPUT : NONE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CLOSERDS: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; IF <TF RECVDSNF> THEN BEGIN % CLOSE INPUT FILE CALL EDCLOS,(EDCNTRL,EDRETURN); % CLOSE INPUT FILE ZF RECVDSNF; L XRA,TMPDISKA; LH XRB,TMPDISKL; IF <EXI XRB,MCLC,VOLUME,0(XRA),*-*,INCR=YES,DECR=YES> & <MCLC STATLEN,=H'0',2> THEN DO BEGIN %VINIT KERMVA,L:ADDSTATA,KERMBUFF,L'KERMBUFF; %VSEG KERMVA,'Data set '; MMVC TMPDSN,DSNAME,44; EXIT IF <CLI STATE,SESTATE> | <CLI STATE,RESTATE>; MMVC TMPVOL,TSOVOL,6; % RETURN ED VOL SERIAL NUMBER LI VR0,TMPMSL; CCALL ADSTATUS,A,VR1=TMPDSMES; %VOUT KERMVA; END; % OF DEFAULT END; % OF CLOSE KEROUT CCALL RECUNAL,A; % UNALLOCATE DS FREEMAIN RU,SP=7; % FREE THE BUFFER ATTEMPT % %NO; ON ORG CHECK USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'KERMTGET'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : KERMTGET % FUNCTION: TIMER ON ALL READS THIS SUB IS ATTACHED % ECB'S CONTROL TIMING FLOW %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KERMTGET: OSENTER (14,12); L XRF,PARMADD2; % SET UP BASE REGISTER L XRB,STAXADD; % PARMETER EXIT ROUTINE ADDRESS L XRC,STAXLADD; % PARM LIST ADDRESS STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC)); FOREVER DO BEGIN % LOOP ALL DAY WAIT ECB=ECBREAD; MZC ECBREAD,4; % ZERO ECB L VR1,TGETBUFA; % ADDRESS OF BUFFER TO PUT IN LI VR0,32767; % MAX VALUE OF TGET ( ALTHOUGH TCAM'S 4 K) TGET (VR1),(VR0),ASIS; IF <RZ VRF> | <CI VRF,18> THEN ST VR1,TGETLEN % LENGTH OF RECEIVED ELSE BEGIN % ERROR ZR VRF; SI VRF,1; ST VRF,TGETLEN; END; POST ECBTGET,ECBTREAD; % TELL EM WE READ IT END; % OF FOREVER DO OSEXIT (14,12); LTORG; PARMADD2: DC A(PARMS); % ADDRESS OF STORAGE SUBTITLE 'ERRPACK'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: ERRPACK % FUNCTION: SEND ERROR PACKETS % INPUT: R1-> MESSAGE STRING % VR0=LENGTH OF MESSAGE % OUTPUT: PRESPARED AND SEND PACKET % MAYBE WAIT ONt( NACK THEN BLOCK OFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ERRPACK: CENTER VRE,HIGHR,ENTRY=NO; IF <CH VR0,MAXPUT; CC H> THEN LH VR0,MAXPUT; % IN CASE TOO BIG DEBLANK VR1,VR0,XRA,BOTH; % DEBLANK ERROR PACKET % SET UP DSECT FOR SEND PACKET LR XRA,VR0; % LENGTH FOR EXECUTE EXI XRA,MMVC,PDATA,0(VR1),*-*,INCR=YES,DECR=YES; STH XRA,PUTLEN; EXI XRA,MMVC,STATBUFF,PDATA,*-*,INCR=YES,DECR=YES; % FINAL STATUS STH XRA,STATLEN; % LENGTH OF BUFFER L XRB,ETOAVCON; EXI XRA,TR,PDATA(*-*),0(XRB),DECR=YES,INCR=YES; % TRANSLATE TO ASCII MVI PTYPE,ACOMLIT; % ABORT LITERAL INTO PACKET % CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'ATOEERRS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: ATOEERRS % FUNCTION: SETS ERROR BUFFER FOR ASCII TO EBCDIC CONVERSION MESSAGE % INPUT: NONE % % OUTPUT: NONE % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ATOEERRS: CENTER VRE,HIGHR,ENTRY=NO; SF WARNINGF; MVC WARNBUFF,=C'Invalid characters for ASCII to EBCDIC translation.'; MMVC WARNLEN,=H'51',2; SF WARNTPCK ; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'ATOE8BIT'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: ATOE8BIT % FUNCTION: SETS ERROR BUFFER FOR ASCII TO EBCDIC CONVERSION MESSAGE % INPUT: VR1=> CHARACTER % % OUTPUT: CHARACTER CONVERSION % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ATOE8BIT: CENTER VRE,HIGHR,ENTRY=NO; SF WARNINGF; MVC WARNBUFF,=C'Eighth bit on for ASCII to EBCDIC translation.'; MMVC WARNLEN,=H'47',2; SF WARNTPCK ; CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'CHKCNTL'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MODULE : CHKCNTL % FUNCTION : CHECKS A NUMBER FOR A VALID QUOTE CHARACTER % CHECKS RANGE AND OTHER QUOTES % INPUT: VRF= NUMBER (BINARY) VR0=1 - CQUOTE % VR0=2 - BQUOTE VR0=3 RQUOTE % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CHKCNTL: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; SELECT FIRST; <CLM VRF,1,QUOCHAR>: % User entered same just fall through BEGIN IF ^<CI VR0,1> THEN % QUOTE CHARACTER WRTERM _ 'Character entered matches CQUOTE character. Change it first.'; ZR VRF; END; <CLM VRF,1,BINQC>: BEGIN % User entered Quote like other IF ^<CI VR0,2> THEN % BQUOTE CHARACTER WRTERM _ 'Character entered matches BQUOTE character. Change it first.'; ZR VRF; END; <CLM VRF,1,REPTCHAR>: BEGIN % User entered Quote like other IF ^<CI VR0,3> THEN % CQUOTE CHARACTER WRTERM _ 'Character entered matches RQUOTE character. Change it first.'; ZR VRF; END; <<CI VRF,32; CC L> | % Check whether number is in range <<CLI VRF,63; CC H> & <CLI VRF,95; CC L>>>: ; % ILLEGAL JUST FALL OUT ENDSEL ELSE BEGIN % We actually have a good quote character % Now take old values out of tables SELECT FIRST; % NOW PICK UP CHARACTER THAT WE'RE QUOTING <CI VR0,1>: LA XRA,QUOCHAR; <CI VR0,2>: LA XRA,BINQC; <CI VR0,3>: LA XRA,REPTCHAR; ENDSEL; LOADB VR0,0(XRA); LA VR1,SENDTBL; AR VR1,VR0; % POINT TO PLACE IN TABLE MVI 0(VR1),0; % QUOTE FOR HASH IN TABLE AI VR1,X'80'; % POINT TO HIGH ORDER MVI 0(VR1),ASCI8BIT; LA VR1,RECTABLE; AR VR1,VR0; % POINT TO PLACE IN TABLE MVI 0(VR1),0; % QUOTE FOR HASH IN TABLE STC VRF,0(XRA); % STORE THE QUOTE CHARACTER ZR VRF; % INDICATE GOOD RETURN END; USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'KSTATUS '; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: KSTATUS % FUNCTION: OUTPUT A MESSAGE TO THE TERM CONCERNING WARNINGS % AND THE FINAL COMPLETION CODE OF THE PROGRAM % INPUT: STATBUFF CONTAINS THE MESSAGE % STATLEN IS THE LENGTH OF MESSAGE % OUTPUT: SCREEN MESSAGE % RETURN : NONE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% KSTATUS: CENTER VRE,HIGHR,ENTRY=NO; VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN; VSEG KERMVA,' TSO KERMIT Status Report'; VOUT KERMVA; % OUTPUT HEADER FOR STATUS REPORT IF <TF WARNINGF> THEN BEGIN % WARNINGS ISSUED LA VR1,WARNBUFF; LH VR0,WARNLEN; VSEG KERMVA,(VR1),(VR0); VOUT KERMVA; % OUTPUT IT TO SCREEN END; LA VR1,STATBUFF; LH VR0,STATLEN; IF <RZ VR0> THEN VSEG KERMVA,SUCESSCC,L'SUCESSCC % GOOD RETURN ELSE VSEG KERMVA,(VR1),(VR0); VOUT KERMVA; % OUTPUT IT TO SCREEN CEXIT VRE,HIGHR; LTORG; EXORG; SUBTITLE 'SETCNTLS'; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MOD: SETCNTLS % FUNCTION: SCAN FOR "^" FORMAT SET PARAMETERS % (E.G. ^A = =X'01' ) % INPUT: VR1=> STRING % VR0=LENGTH % OUTPUT: VRF= CONVERTED NUMBER - NEGATIVE NUMBERS= ILLEGAL %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SETCNTLS: CENTER VRE,HIGHR,WASIZE,ENTRY=NO; SCPUSH; ZR VRF; SCINIT (VR1),(VR0); % REINITIALIZE SCANNER SCAN *; SCKW ,STORCNTL,I,LIMIT=AL1(32); % HIGHEST NUMBER SCKW ^,CNTLETTR; % A CNTL LETTER (E.G. ^A = X'01') SCKW NUL,*,CODE=AL1(0); SCKW SOH,*,CODE=AL1(1); SCKW STX,*,CODE=AL1(2); SCKW ETX,*,CODE=AL1(3); SCKW EOT,*,CODE=AL1(4); SCKW ENQ,*,CODE=AL1(5); SCKW ACK,*,CODE=AL1(6); SCKW BEL,*,CODE=AL1(7); SCKW BS,*,CODE=AL1(8); SCKW HT,*,CODE=AL1(9); SCKW LF,*,CODE=AL1(10); SCKW VT,*,CODE=AL1(11); SCKW FF,*,CODE=AL1(12); SCKW CR,*,CODE=AL1(13); SCKW SO,*,CODE=AL1(14); SCKW SI,*,CODE=AL1(15); SCKW DLE,*,CODE=AL1(16); SCKW DC1,*,CODE=AL1(17); SCKW DC2,*,CODE=AL1(18); SCKW DC3,*,CODE=AL1(19); SCKW DC4,*,CODE=AL1(20); SCKW NAK,*,CODE=AL1(21); SCKW SYN,*,CODE=AL1(22); SCKW ETB,*,CODE=AL1(23); SCKW CAN,*,CODE=AL1(24); SCKW EM,*,CODE=AL1(25); SCKW SUB,*,CODE=AL1(26); SCKW ESC,*,CODE=AL1(27); SCKW FS,*,CODE=AL1(28); SCKW GS,*,CODE=AL1(29); SCKW RS,*,CODE=AL1(30); SCKW US,*,CODE=AL1(31); SCKW ,*,CODE=AL1(-1); % ILLEGAL VALUE SCANEND; DATA BEGIN % START OF ANTHER SCAN CNTLETTR: ; SCPOP; SCTELL; IF <CI VR0,1> THEN BEGIN % IS THERE ONE CHARACTER SCINIT (VR1),(VR0); SCAN *; SCKW @,*,CODE=AL1(0); SCKW A,*,CODE=AL1(1); SCKW B,*,CODE=AL1(2); SCKW C,*,CODE=AL1(3); SCKW D,*,CODE=AL1(4); SCKW E,*,CODE=AL1(5); SCKW F,*,CODE=AL1(6); SCKW G,*,CODE=AL1(7); SCKW H,*,CODE=AL1(8); SCKW I,*,CODE=AL1(9); SCKW J,*,CODE=AL1(10); SCKW K,*,CODE=AL1(11); SCKW L,*,CODE=AL1(12); SCKW M,*,CODE=AL1(13); SCKW N,*,CODE=AL1(14); SCKW O,*,CODE=AL1(15); SCKW P,*,CODE=AL1(16); SCKW Q,*,CODE=AL1(17); SCKW R,*,CODE=AL1(18); SCKW S,*,CODE=AL1(19); SCKW T,*,CODE=AL1(20); SCKW U,*,CODE=AL1(21); SCKW V,*,CODE=AL1(22); SCKW W,*,CODE=AL1(23); SCKW X,*,CODE=AL1(24); SCKW Y,*,CODE=AL1(25); SCKW Z,*,CODE=AL1(26); SCKW [,*,CODE=AL1(27); SCKW \,*,CODE=AL1(28); SCKW ],*,CODE=AL1(29); SCKW ,*,CODE=AL1(30); SCKW _,*,CODE=AL1(31); SCKW ,*,CODE=AL1(-1); SCANEND; END % OF ONE CHARACTER TO SCAN ELSE <ZR VRE; SI VRE,1>; % ERROR RETURN SCPUSH; END; % OF BLOCK LR VRF,VRE; % LOAD VALUE IN RETURN REGISTER STORCNTL: USE WAR AS WA IN ST VRF,WAVRF; % STORE VRF SCPOP; % RESTORE SCANNER CEXIT VRE,HIGHR; LTORG; SUBTITLE 'DSECTS AND BIG BUFFERS'; NOTOUCH: DC F'0'; % WORD FOR LRECL BUF: DS CL32000; % DISK READ INTO HERE; TGETBUFF: DS CL33000; % LENTH OF TGET BUFFER USERWORK: AREA H,DSECT=NO; LENWK: DC H'32004'; % LENGTH OF WORKAREA DATALEN: DC H'0'; % LENGTH OF RETURNED DATA RETURNDS: DS CL32000; % DATA SET NAME VOLJUNK: DC 15AL1(0); % VOL INFO AREAEND; NOQUOTE: AREA F,DSECT=NO; DC 256AL1(0); % TABLE FOR NON QUOTED CHARACTERS AREAEND; % DSECTS FOR PACKETS PACKET: AREA F,DSECT=YES; MARK: DS X; % ^A SOH CHARACTER LEN: DS X; % LENGTH OF PACKET-2 SEQ: DS X; % 0-63 (MOD 64) SEQUENCE NUMBER TYPE: DS X; % PACKET TYPE DATABUFF: DS CL92; % MAX PACKET DATABUFF PACKETL: AREAEND; SPACKET: AREA F,DSECT=YES; SMARK: DS X; % ^A SOH CHARACTER SLEN: DS X; % LENGTH OF PACKET-2 SSEQ: DS X; % 0-63 (MOD 64) SEQUENCE NUMBER STYPE: DS X; % PACKET TYPE SDATABUF: DS CL92; % MAX PACKET DATABUFF SPACKETL: AREAEND; SENDIDST: AREA H,DSECT=YES; MAXL: DS X; % MAX PACKET LENGTH MAX 94 TIME: DS X; % TIMEOUT FOR RECIEVER NPAD: DS X; % NUMBER OF PAD CHARS (0) PADC: DS X; % THE CONTROL CHAR OF PAD EOLCHAR: DS X; % CHARACTER TO TERMINATE IN PACK QCTL: DS X; % ASCII QUOTE CHAR QBIN: DS X; % ASCII BIN QUOTE CHAR CHKT: DS X; % CHARACTER CHECKING REPT: DS X; % PREFIX REPEAT CHAR CAPA1: DS X; % CAPABILITIES SENDINIL: AREAEND; %%DSECTS END RECINIT: AREA H,DSECT=YES; RMAXL: DS X; % MAX PACKET LENGTH MAX 94 RTIME: DS X; % TIMEOUT FOR RECIEVER RNPAD: DS X; % NUMBER OF PAD CHARS (0) RPADC: DS X; % THE CONTROL CHAR OF PAD REOLCHAR: DS X; % CHARACTER TO TERMINATE IN PACK RQCTL: DS X; % ASCII QUOTE CHAR RQBIN: DS X; % ASCII BIN QUOTE CHAR RCHKT: DS X; % CHARACTER CHECKING RREPT: DS X; % PREFIX REPEAT CHAR RCAPA1: DS X; % CAPABILITIES RECINIL: AREAEND; DCBD: AREA F,DSECT=YES; DCBD DSORG=(PS),DEVD=DA; DCBDL: AREAEND; CATDSET: AREA ,DSECT=YES; TYPEBYTE: DS XL1; % TYPE BYTE WE WANT ONLY A'S CATDNAME: DS 44CL1; % DATA SET NAME AREAEND; END;